Theory AuxLemmas
section ‹Auxiliary lemmas›
theory AuxLemmas imports Main begin
abbreviation "arbitrary == undefined"
text ‹Lemmas about left- and rightmost elements in lists›
lemma leftmost_element_property:
assumes "∃x ∈ set xs. P x"
obtains zs x' ys where "xs = zs@x'#ys" and "P x'" and "∀z ∈ set zs. ¬ P z"
proof(atomize_elim)
from ‹∃x ∈ set xs. P x›
show "∃zs x' ys. xs = zs @ x' # ys ∧ P x' ∧ (∀z∈set zs. ¬ P z)"
proof(induct xs)
case Nil thus ?case by simp
next
case (Cons x' xs')
note IH = ‹∃a∈set xs'. P a
⟹ ∃zs x' ys. xs' = zs@x'#ys ∧ P x' ∧ (∀z∈set zs. ¬ P z)›
show ?case
proof (cases "P x'")
case True
then have "(∃ys. x' # xs' = [] @ x' # ys) ∧ P x' ∧ (∀x∈set []. ¬ P x)" by simp
then show ?thesis by blast
next
case False
with ‹∃y∈set (x'#xs'). P y› have "∃y∈set xs'. P y" by simp
from IH[OF this] obtain y ys zs where "xs' = zs@y#ys"
and "P y" and "∀z∈set zs. ¬ P z" by blast
from ‹∀z∈set zs. ¬ P z› False have "∀z∈set (x'#zs). ¬ P z" by simp
with ‹xs' = zs@y#ys› ‹P y› show ?thesis by (metis Cons_eq_append_conv)
qed
qed
qed
lemma rightmost_element_property:
assumes "∃x ∈ set xs. P x"
obtains ys x' zs where "xs = ys@x'#zs" and "P x'" and "∀z ∈ set zs. ¬ P z"
proof(atomize_elim)
from ‹∃x ∈ set xs. P x›
show "∃ys x' zs. xs = ys @ x' # zs ∧ P x' ∧ (∀z∈set zs. ¬ P z)"
proof(induct xs)
case Nil thus ?case by simp
next
case (Cons x' xs')
note IH = ‹∃a∈set xs'. P a
⟹ ∃ys x' zs. xs' = ys @ x' # zs ∧ P x' ∧ (∀z∈set zs. ¬ P z)›
show ?case
proof(cases "∃y∈set xs'. P y")
case True
from IH[OF this] obtain y ys zs where "xs' = ys @ y # zs"
and "P y" and "∀z∈set zs. ¬ P z" by blast
thus ?thesis by (metis Cons_eq_append_conv)
next
case False
with ‹∃y∈set (x'#xs'). P y› have "P x'" by simp
with False show ?thesis by (metis eq_Nil_appendI)
qed
qed
qed
text ‹Lemma concerning maps and ‹@››
lemma map_append_append_maps:
assumes map:"map f xs = ys@zs"
obtains xs' xs'' where "map f xs' = ys" and "map f xs'' = zs" and "xs=xs'@xs''"
by (metis append_eq_conv_conj append_take_drop_id assms drop_map take_map that)
text ‹Lemma concerning splitting of @{term list}s›
lemma path_split_general:
assumes all:"∀zs. xs ≠ ys@zs"
obtains j zs where "xs = (take j ys)@zs" and "j < length ys"
and "∀k > j. ∀zs'. xs ≠ (take k ys)@zs'"
proof(atomize_elim)
from ‹∀zs. xs ≠ ys@zs›
show "∃j zs. xs = take j ys @ zs ∧ j < length ys ∧
(∀k>j. ∀zs'. xs ≠ take k ys @ zs')"
proof(induct ys arbitrary:xs)
case Nil thus ?case by auto
next
case (Cons y' ys')
note IH = ‹⋀xs. ∀zs. xs ≠ ys' @ zs ⟹
∃j zs. xs = take j ys' @ zs ∧ j < length ys' ∧
(∀k. j < k ⟶ (∀zs'. xs ≠ take k ys' @ zs'))›
show ?case
proof(cases xs)
case Nil thus ?thesis by simp
next
case (Cons x' xs')
with ‹∀zs. xs ≠ (y' # ys') @ zs› have "x' ≠ y' ∨ (∀zs. xs' ≠ ys' @ zs)"
by simp
show ?thesis
proof(cases "x' = y'")
case True
with ‹x' ≠ y' ∨ (∀zs. xs' ≠ ys' @ zs)› have "∀zs. xs' ≠ ys' @ zs" by simp
from IH[OF this] have "∃j zs. xs' = take j ys' @ zs ∧ j < length ys' ∧
(∀k. j < k ⟶ (∀zs'. xs' ≠ take k ys' @ zs'))" .
then obtain j zs where "xs' = take j ys' @ zs"
and "j < length ys'"
and all_sub:"∀k. j < k ⟶ (∀zs'. xs' ≠ take k ys' @ zs')"
by blast
from ‹xs' = take j ys' @ zs› True
have "(x'#xs') = take (Suc j) (y' # ys') @ zs"
by simp
from all_sub True have all_imp:"∀k. j < k ⟶
(∀zs'. (x'#xs') ≠ take (Suc k) (y' # ys') @ zs')"
by auto
{ fix l assume "(Suc j) < l"
then obtain k where [simp]:"l = Suc k" by(cases l) auto
with ‹(Suc j) < l› have "j < k" by simp
with all_imp
have "∀zs'. (x'#xs') ≠ take (Suc k) (y' # ys') @ zs'"
by simp
hence "∀zs'. (x'#xs') ≠ take l (y' # ys') @ zs'"
by simp }
with ‹(x'#xs') = take (Suc j) (y' # ys') @ zs› ‹j < length ys'› Cons
show ?thesis by (metis Suc_length_conv less_Suc_eq_0_disj)
next
case False
with Cons have "∀i zs'. i > 0 ⟶ xs ≠ take i (y' # ys') @ zs'"
by auto(case_tac i,auto)
moreover
have "∃zs. xs = take 0 (y' # ys') @ zs" by simp
ultimately show ?thesis by(rule_tac x="0" in exI,auto)
qed
qed
qed
qed
end
Theory BasicDefs
chapter ‹The Framework›
theory BasicDefs imports AuxLemmas begin
text ‹
As slicing is a program analysis that can be completely based on the
information given in the CFG, we want to provide a framework which
allows us to formalize and prove properties of slicing regardless of
the actual programming language. So the starting point for the formalization
is the definition of an abstract CFG, i.e.\ without considering features
specific for certain languages. By doing so we ensure that our framework
is as generic as possible since all proofs hold for every language whose
CFG conforms to this abstract CFG. This abstract CFG can be used as a
basis for static intraprocedural slicing as well as for dynamic slicing,
if in the dynamic case all method calls are inlined (i.e., abstract CFG
paths conform to traces).
›
section ‹Basic Definitions›
subsection‹Edge kinds›
datatype 'state edge_kind = Update "'state ⇒ 'state" ("⇑_")
| Predicate "'state ⇒ bool" ("'(_')⇩√")
subsection ‹Transfer and predicate functions›
fun transfer :: "'state edge_kind ⇒ 'state ⇒ 'state"
where "transfer (⇑f) s = f s"
| "transfer (P)⇩√ s = s"
fun transfers :: "'state edge_kind list ⇒ 'state ⇒ 'state"
where "transfers [] s = s"
| "transfers (e#es) s = transfers es (transfer e s)"
fun pred :: "'state edge_kind ⇒ 'state ⇒ bool"
where "pred (⇑f) s = True"
| "pred (P)⇩√ s = (P s)"
fun preds :: "'state edge_kind list ⇒ 'state ⇒ bool"
where "preds [] s = True"
| "preds (e#es) s = (pred e s ∧ preds es (transfer e s))"
lemma transfers_split:
"(transfers (ets@ets') s) = (transfers ets' (transfers ets s))"
by(induct ets arbitrary:s) auto
lemma preds_split:
"(preds (ets@ets') s) = (preds ets s ∧ preds ets' (transfers ets s))"
by(induct ets arbitrary:s) auto
lemma transfers_id_no_influence:
"transfers [et ← ets. et ≠ ⇑id] s = transfers ets s"
by(induct ets arbitrary:s,auto)
lemma preds_True_no_influence:
"preds [et ← ets. et ≠ (λs. True)⇩√] s = preds ets s"
by(induct ets arbitrary:s,auto)
end
Theory CFG
section ‹CFG›
theory CFG imports BasicDefs begin
subsection ‹The abstract CFG›
locale CFG =
fixes sourcenode :: "'edge ⇒ 'node"
fixes targetnode :: "'edge ⇒ 'node"
fixes kind :: "'edge ⇒ 'state edge_kind"
fixes valid_edge :: "'edge ⇒ bool"
fixes Entry::"'node" ("'('_Entry'_')")
assumes Entry_target [dest]: "⟦valid_edge a; targetnode a = (_Entry_)⟧ ⟹ False"
and edge_det:
"⟦valid_edge a; valid_edge a'; sourcenode a = sourcenode a';
targetnode a = targetnode a'⟧ ⟹ a = a'"
begin
definition valid_node :: "'node ⇒ bool"
where "valid_node n ≡
(∃a. valid_edge a ∧ (n = sourcenode a ∨ n = targetnode a))"
lemma [simp]: "valid_edge a ⟹ valid_node (sourcenode a)"
by(fastforce simp:valid_node_def)
lemma [simp]: "valid_edge a ⟹ valid_node (targetnode a)"
by(fastforce simp:valid_node_def)
subsection ‹CFG paths and lemmas›
inductive path :: "'node ⇒ 'edge list ⇒ 'node ⇒ bool"
("_ -_→* _" [51,0,0] 80)
where
empty_path:"valid_node n ⟹ n -[]→* n"
| Cons_path:
"⟦n'' -as→* n'; valid_edge a; sourcenode a = n; targetnode a = n''⟧
⟹ n -a#as→* n'"
lemma path_valid_node:
assumes "n -as→* n'" shows "valid_node n" and "valid_node n'"
using ‹n -as→* n'›
by(induct rule:path.induct,auto)
lemma empty_path_nodes [dest]:"n -[]→* n' ⟹ n = n'"
by(fastforce elim:path.cases)
lemma path_valid_edges:"n -as→* n' ⟹ ∀a ∈ set as. valid_edge a"
by(induct rule:path.induct) auto
lemma path_edge:"valid_edge a ⟹ sourcenode a -[a]→* targetnode a"
by(fastforce intro:Cons_path empty_path)
lemma path_Entry_target [dest]:
assumes "n -as→* (_Entry_)"
shows "n = (_Entry_)" and "as = []"
using ‹n -as→* (_Entry_)›
proof(induct n as n'≡"(_Entry_)" rule:path.induct)
case (Cons_path n'' as a n)
from ‹targetnode a = n''› ‹valid_edge a› ‹n'' = (_Entry_)› have False
by -(rule Entry_target,simp_all)
{ case 1
with ‹False› show ?case ..
next
case 2
with ‹False› show ?case ..
}
qed simp_all
lemma path_Append:"⟦n -as→* n''; n'' -as'→* n'⟧
⟹ n -as@as'→* n'"
by(induct rule:path.induct,auto intro:Cons_path)
lemma path_split:
assumes "n -as@a#as'→* n'"
shows "n -as→* sourcenode a" and "valid_edge a" and "targetnode a -as'→* n'"
using ‹n -as@a#as'→* n'›
proof(induct as arbitrary:n)
case Nil case 1
thus ?case by(fastforce elim:path.cases intro:empty_path)
next
case Nil case 2
thus ?case by(fastforce elim:path.cases intro:path_edge)
next
case Nil case 3
thus ?case by(fastforce elim:path.cases)
next
case (Cons ax asx)
note IH1 = ‹⋀n. n -asx@a#as'→* n' ⟹ n -asx→* sourcenode a›
note IH2 = ‹⋀n. n -asx@a#as'→* n' ⟹ valid_edge a›
note IH3 = ‹⋀n. n -asx@a#as'→* n' ⟹ targetnode a -as'→* n'›
{ case 1
hence "sourcenode ax = n" and "targetnode ax -asx@a#as'→* n'" and "valid_edge ax"
by(auto elim:path.cases)
from IH1[OF ‹ targetnode ax -asx@a#as'→* n'›]
have "targetnode ax -asx→* sourcenode a" .
with ‹sourcenode ax = n› ‹valid_edge ax› show ?case by(fastforce intro:Cons_path)
next
case 2 hence "targetnode ax -asx@a#as'→* n'" by(auto elim:path.cases)
from IH2[OF this] show ?case .
next
case 3 hence "targetnode ax -asx@a#as'→* n'" by(auto elim:path.cases)
from IH3[OF this] show ?case .
}
qed
lemma path_split_Cons:
assumes "n -as→* n'" and "as ≠ []"
obtains a' as' where "as = a'#as'" and "n = sourcenode a'"
and "valid_edge a'" and "targetnode a' -as'→* n'"
proof -
from ‹as ≠ []› obtain a' as' where "as = a'#as'" by(cases as) auto
with ‹n -as→* n'› have "n -[]@a'#as'→* n'" by simp
hence "n -[]→* sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
by(rule path_split)+
from ‹n -[]→* sourcenode a'› have "n = sourcenode a'" by fast
with ‹as = a'#as'› ‹valid_edge a'› ‹targetnode a' -as'→* n'› that show ?thesis
by fastforce
qed
lemma path_split_snoc:
assumes "n -as→* n'" and "as ≠ []"
obtains a' as' where "as = as'@[a']" and "n -as'→* sourcenode a'"
and "valid_edge a'" and "n' = targetnode a'"
proof -
from ‹as ≠ []› obtain a' as' where "as = as'@[a']" by(cases as rule:rev_cases) auto
with ‹n -as→* n'› have "n -as'@a'#[]→* n'" by simp
hence "n -as'→* sourcenode a'" and "valid_edge a'" and "targetnode a' -[]→* n'"
by(rule path_split)+
from ‹targetnode a' -[]→* n'› have "n' = targetnode a'" by fast
with ‹as = as'@[a']› ‹valid_edge a'› ‹n -as'→* sourcenode a'› that show ?thesis
by fastforce
qed
lemma path_split_second:
assumes "n -as@a#as'→* n'" shows "sourcenode a -a#as'→* n'"
proof -
from ‹n -as@a#as'→* n'› have "valid_edge a" and "targetnode a -as'→* n'"
by(auto intro:path_split)
thus ?thesis by(fastforce intro:Cons_path)
qed
lemma path_Entry_Cons:
assumes "(_Entry_) -as→* n'" and "n' ≠ (_Entry_)"
obtains n a where "sourcenode a = (_Entry_)" and "targetnode a = n"
and "n -tl as→* n'" and "valid_edge a" and "a = hd as"
proof -
from ‹(_Entry_) -as→* n'› ‹n' ≠ (_Entry_)› have "as ≠ []"
by(cases as,auto elim:path.cases)
with ‹(_Entry_) -as→* n'› obtain a' as' where "as = a'#as'"
and "(_Entry_) = sourcenode a'" and "valid_edge a'" and "targetnode a' -as'→* n'"
by(erule path_split_Cons)
with that show ?thesis by fastforce
qed
lemma path_det:
"⟦n -as→* n'; n -as→* n''⟧ ⟹ n' = n''"
proof(induct as arbitrary:n)
case Nil thus ?case by(auto elim:path.cases)
next
case (Cons a' as')
note IH = ‹⋀n. ⟦n -as'→* n'; n -as'→* n''⟧ ⟹ n' = n''›
from ‹n -a'#as'→* n'› have "targetnode a' -as'→* n'"
by(fastforce elim:path_split_Cons)
from ‹n -a'#as'→* n''› have "targetnode a' -as'→* n''"
by(fastforce elim:path_split_Cons)
from IH[OF ‹targetnode a' -as'→* n'› this] show ?thesis .
qed
definition
sourcenodes :: "'edge list ⇒ 'node list"
where "sourcenodes xs ≡ map sourcenode xs"
definition
kinds :: "'edge list ⇒ 'state edge_kind list"
where "kinds xs ≡ map kind xs"
definition
targetnodes :: "'edge list ⇒ 'node list"
where "targetnodes xs ≡ map targetnode xs"
lemma path_sourcenode:
"⟦n -as→* n'; as ≠ []⟧ ⟹ hd (sourcenodes as) = n"
by(fastforce elim:path_split_Cons simp:sourcenodes_def)
lemma path_targetnode:
"⟦n -as→* n'; as ≠ []⟧ ⟹ last (targetnodes as) = n'"
by(fastforce elim:path_split_snoc simp:targetnodes_def)
lemma sourcenodes_is_n_Cons_butlast_targetnodes:
"⟦n -as→* n'; as ≠ []⟧ ⟹
sourcenodes as = n#(butlast (targetnodes as))"
proof(induct as arbitrary:n)
case Nil thus ?case by simp
next
case (Cons a' as')
note IH = ‹⋀n. ⟦n -as'→* n'; as' ≠ []⟧
⟹ sourcenodes as' = n#(butlast (targetnodes as'))›
from ‹n -a'#as'→* n'› have "n = sourcenode a'" and "targetnode a' -as'→* n'"
by(auto elim:path_split_Cons)
show ?case
proof(cases "as' = []")
case True
with ‹targetnode a' -as'→* n'› have "targetnode a' = n'" by fast
with True ‹n = sourcenode a'› show ?thesis
by(simp add:sourcenodes_def targetnodes_def)
next
case False
from IH[OF ‹targetnode a' -as'→* n'› this]
have "sourcenodes as' = targetnode a' # butlast (targetnodes as')" .
with ‹n = sourcenode a'› False show ?thesis
by(simp add:sourcenodes_def targetnodes_def)
qed
qed
lemma targetnodes_is_tl_sourcenodes_App_n':
"⟦n -as→* n'; as ≠ []⟧ ⟹
targetnodes as = (tl (sourcenodes as))@[n']"
proof(induct as arbitrary:n' rule:rev_induct)
case Nil thus ?case by simp
next
case (snoc a' as')
note IH = ‹⋀n'. ⟦n -as'→* n'; as' ≠ []⟧
⟹ targetnodes as' = tl (sourcenodes as') @ [n']›
from ‹n -as'@[a']→* n'› have "n -as'→* sourcenode a'" and "n' = targetnode a'"
by(auto elim:path_split_snoc)
show ?case
proof(cases "as' = []")
case True
with ‹n -as'→* sourcenode a'› have "n = sourcenode a'" by fast
with True ‹n' = targetnode a'› show ?thesis
by(simp add:sourcenodes_def targetnodes_def)
next
case False
from IH[OF ‹n -as'→* sourcenode a'› this]
have "targetnodes as' = tl (sourcenodes as')@[sourcenode a']" .
with ‹n' = targetnode a'› False show ?thesis
by(simp add:sourcenodes_def targetnodes_def)
qed
qed
lemma Entry_sourcenode_hd:
assumes "n -as→* n'" and "(_Entry_) ∈ set (sourcenodes as)"
shows "n = (_Entry_)" and "(_Entry_) ∉ set (sourcenodes (tl as))"
using ‹n -as→* n'› ‹(_Entry_) ∈ set (sourcenodes as)›
proof(induct rule:path.induct)
case (empty_path n) case 1
thus ?case by(simp add:sourcenodes_def)
next
case (empty_path n) case 2
thus ?case by(simp add:sourcenodes_def)
next
case (Cons_path n'' as n' a n)
note IH1 = ‹(_Entry_) ∈ set(sourcenodes as) ⟹ n'' = (_Entry_)›
note IH2 = ‹(_Entry_) ∈ set(sourcenodes as) ⟹ (_Entry_) ∉ set(sourcenodes(tl as))›
have "(_Entry_) ∉ set (sourcenodes(tl(a#as)))"
proof
assume "(_Entry_) ∈ set (sourcenodes (tl (a#as)))"
hence "(_Entry_) ∈ set (sourcenodes as)" by simp
from IH1[OF this] have "n'' = (_Entry_)" by simp
with ‹targetnode a = n''› ‹valid_edge a› show False by -(erule Entry_target,simp)
qed
hence "(_Entry_) ∉ set (sourcenodes(tl(a#as)))" by fastforce
{ case 1
with ‹(_Entry_) ∉ set (sourcenodes(tl(a#as)))› ‹sourcenode a = n›
show ?case by(simp add:sourcenodes_def)
next
case 2
with ‹(_Entry_) ∉ set (sourcenodes(tl(a#as)))› ‹sourcenode a = n›
show ?case by(simp add:sourcenodes_def)
}
qed
end
end
Theory CFGExit
theory CFGExit imports CFG begin
subsection ‹Adds an exit node to the abstract CFG›
locale CFGExit = CFG sourcenode targetnode kind valid_edge Entry
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") +
fixes Exit::"'node" ("'('_Exit'_')")
assumes Exit_source [dest]: "⟦valid_edge a; sourcenode a = (_Exit_)⟧ ⟹ False"
and Entry_Exit_edge: "∃a. valid_edge a ∧ sourcenode a = (_Entry_) ∧
targetnode a = (_Exit_) ∧ kind a = (λs. False)⇩√"
begin
lemma Entry_noteq_Exit [dest]:
assumes eq:"(_Entry_) = (_Exit_)" shows "False"
proof -
from Entry_Exit_edge obtain a where "sourcenode a = (_Entry_)"
and "valid_edge a" by blast
with eq show False by simp(erule Exit_source)
qed
lemma Exit_noteq_Entry [dest]:"(_Exit_) = (_Entry_) ⟹ False"
by(rule Entry_noteq_Exit[OF sym],simp)
lemma [simp]: "valid_node (_Entry_)"
proof -
from Entry_Exit_edge obtain a where "sourcenode a = (_Entry_)"
and "valid_edge a" by blast
thus ?thesis by(fastforce simp:valid_node_def)
qed
lemma [simp]: "valid_node (_Exit_)"
proof -
from Entry_Exit_edge obtain a where "targetnode a = (_Exit_)"
and "valid_edge a" by blast
thus ?thesis by(fastforce simp:valid_node_def)
qed
definition inner_node :: "'node ⇒ bool"
where inner_node_def:
"inner_node n ≡ valid_node n ∧ n ≠ (_Entry_) ∧ n ≠ (_Exit_)"
lemma inner_is_valid:
"inner_node n ⟹ valid_node n"
by(simp add:inner_node_def valid_node_def)
lemma [dest]:
"inner_node (_Entry_) ⟹ False"
by(simp add:inner_node_def)
lemma [dest]:
"inner_node (_Exit_) ⟹ False"
by(simp add:inner_node_def)
lemma [simp]:"⟦valid_edge a; targetnode a ≠ (_Exit_)⟧
⟹ inner_node (targetnode a)"
by(simp add:inner_node_def,rule ccontr,simp,erule Entry_target)
lemma [simp]:"⟦valid_edge a; sourcenode a ≠ (_Entry_)⟧
⟹ inner_node (sourcenode a)"
by(simp add:inner_node_def,rule ccontr,simp,erule Exit_source)
lemma valid_node_cases [consumes 1, case_names "Entry" "Exit" "inner"]:
"⟦valid_node n; n = (_Entry_) ⟹ Q; n = (_Exit_) ⟹ Q;
inner_node n ⟹ Q⟧ ⟹ Q"
apply(auto simp:valid_node_def)
apply(case_tac "sourcenode a = (_Entry_)") apply auto
apply(case_tac "targetnode a = (_Exit_)") apply auto
done
lemma path_Exit_source [dest]:
assumes "(_Exit_) -as→* n'" shows "n' = (_Exit_)" and "as = []"
using ‹(_Exit_) -as→* n'›
proof(induct n≡"(_Exit_)" as n' rule:path.induct)
case (Cons_path n'' as n' a)
from ‹sourcenode a = (_Exit_)› ‹valid_edge a› have False
by -(rule Exit_source,simp_all)
{ case 1 with ‹False› show ?case ..
next
case 2 with ‹False› show ?case ..
}
qed simp_all
lemma Exit_no_sourcenode[dest]:
assumes isin:"(_Exit_) ∈ set (sourcenodes as)" and path:"n -as→* n'"
shows False
proof -
from isin obtain ns' ns'' where "sourcenodes as = ns'@(_Exit_)#ns''"
by(auto dest:split_list simp:sourcenodes_def)
then obtain as' as'' a where "as = as'@a#as''"
and source:"sourcenode a = (_Exit_)"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
with path have "valid_edge a" by(fastforce dest:path_split)
with source show ?thesis by -(erule Exit_source)
qed
end
end
Theory Postdomination
section ‹Postdomination›
theory Postdomination imports CFGExit begin
subsection ‹Standard Postdomination›
locale Postdomination = CFGExit sourcenode targetnode kind valid_edge Entry Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Exit :: "'node" ("'('_Exit'_')") +
assumes Entry_path:"valid_node n ⟹ ∃as. (_Entry_) -as→* n"
and Exit_path:"valid_node n ⟹ ∃as. n -as→* (_Exit_)"
begin
definition postdominate :: "'node ⇒ 'node ⇒ bool" ("_ postdominates _" [51,0])
where postdominate_def:"n' postdominates n ≡
(valid_node n ∧ valid_node n' ∧
((∀as. n -as→* (_Exit_) ⟶ n' ∈ set (sourcenodes as))))"
lemma postdominate_implies_path:
assumes "n' postdominates n" obtains as where "n -as→* n'"
proof(atomize_elim)
from ‹n' postdominates n› have "valid_node n"
and all:"∀as. n -as→* (_Exit_) ⟶ n' ∈ set(sourcenodes as)"
by(auto simp:postdominate_def)
from ‹valid_node n› obtain as where "n -as→* (_Exit_)" by(auto dest:Exit_path)
with all have "n' ∈ set(sourcenodes as)" by simp
then obtain ns ns' where "sourcenodes as = ns@n'#ns'" by(auto dest:split_list)
then obtain as' a as'' where "sourcenodes as' = ns"
and "sourcenode a = n'" and "as = as'@a#as''"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹n -as→* (_Exit_)› ‹as = as'@a#as''› have "n -as'→* sourcenode a"
by(fastforce dest:path_split)
with ‹sourcenode a = n'› show "∃as. n -as→* n'" by blast
qed
lemma postdominate_refl:
assumes valid:"valid_node n" and notExit:"n ≠ (_Exit_)"
shows "n postdominates n"
using valid
proof(induct rule:valid_node_cases)
case Entry
{ fix as assume path:"(_Entry_) -as→* (_Exit_)"
hence notempty:"as ≠ []"
apply - apply(erule path.cases)
by (drule sym,simp,drule Exit_noteq_Entry,auto)
with path have "hd (sourcenodes as) = (_Entry_)"
by(fastforce intro:path_sourcenode)
with notempty have "(_Entry_) ∈ set (sourcenodes as)"
by(fastforce intro:hd_in_set simp:sourcenodes_def) }
with Entry show ?thesis by(simp add:postdominate_def)
next
case Exit
with notExit have False by simp
thus ?thesis by simp
next
case inner
show ?thesis
proof(cases "∃as. n -as→* (_Exit_)")
case True
{ fix as' assume path':"n -as'→* (_Exit_)"
with inner have notempty:"as' ≠ []"
by(cases as',auto elim!:path.cases simp:inner_node_def)
with path' inner have hd:"hd (sourcenodes as') = n"
by -(rule path_sourcenode)
from notempty have "sourcenodes as' ≠ []" by(simp add:sourcenodes_def)
with hd[THEN sym] have "n ∈ set (sourcenodes as')" by simp }
hence "∀as. n -as→* (_Exit_) ⟶ n ∈ set (sourcenodes as)" by simp
with True inner show ?thesis by(simp add:postdominate_def inner_is_valid)
next
case False
with inner show ?thesis by(simp add:postdominate_def inner_is_valid)
qed
qed
lemma postdominate_trans:
assumes pd1:"n'' postdominates n" and pd2:"n' postdominates n''"
shows "n' postdominates n"
proof -
from pd1 pd2 have valid:"valid_node n" and valid':"valid_node n'"
by(simp_all add:postdominate_def)
{ fix as assume path:"n -as→* (_Exit_)"
with pd1 have "n'' ∈ set (sourcenodes as)" by(simp add:postdominate_def)
then obtain ns' ns'' where "sourcenodes as = ns'@n''#ns''"
by(auto dest:split_list)
then obtain as' as'' a
where as'':"sourcenodes as'' = ns''" and as:"as=as'@a#as''"
and source:"sourcenode a = n''"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from as path have "n -as'@a#as''→* (_Exit_)" by simp
with source have path':"n'' -a#as''→* (_Exit_)"
by(fastforce dest:path_split_second)
with pd2 have "n' ∈ set(sourcenodes (a#as''))"
by(auto simp:postdominate_def)
with as have "n' ∈ set(sourcenodes as)" by(auto simp:sourcenodes_def) }
with valid valid' show ?thesis by(simp add:postdominate_def)
qed
lemma postdominate_antisym:
assumes pd1:"n' postdominates n" and pd2:"n postdominates n'"
shows "n = n'"
proof -
from pd1 have valid:"valid_node n" and valid':"valid_node n'"
by(auto simp:postdominate_def)
from valid obtain as where path1:"n -as→* (_Exit_)" by(fastforce dest:Exit_path)
from valid' obtain as' where path2:"n' -as'→* (_Exit_)" by(fastforce dest:Exit_path)
from pd1 path1 have "∃nx ∈ set(sourcenodes as). nx = n'"
by(simp add:postdominate_def)
then obtain ns ns' where sources:"sourcenodes as = ns@n'#ns'"
and all:"∀nx ∈ set ns'. nx ≠ n'"
by(fastforce elim!: rightmost_element_property)
from sources obtain asx a asx' where ns':"ns' = sourcenodes asx'"
and as:"as = asx@a#asx'" and source:"sourcenode a = n'"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from path1 as have "n -asx@a#asx'→* (_Exit_)" by simp
with source have "n' -a#asx'→* (_Exit_)" by(fastforce dest:path_split_second)
with pd2 have "n ∈ set(sourcenodes (a#asx'))" by(simp add:postdominate_def)
with source have "n = n' ∨ n ∈ set(sourcenodes asx')" by(simp add:sourcenodes_def)
thus ?thesis
proof
assume "n = n'" thus ?thesis .
next
assume "n ∈ set(sourcenodes asx')"
then obtain nsx' nsx'' where "sourcenodes asx' = nsx'@n#nsx''"
by(auto dest:split_list)
then obtain asi asi' a' where asx':"asx' = asi@a'#asi'"
and source':"sourcenode a' = n"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
with path1 as have "n -(asx@a#asi)@a'#asi'→* (_Exit_)" by simp
with source' have "n -a'#asi'→* (_Exit_)" by(fastforce dest:path_split_second)
with pd1 have "n' ∈ set(sourcenodes (a'#asi'))" by(auto simp:postdominate_def)
with source' have "n' = n ∨ n' ∈ set(sourcenodes asi')"
by(simp add:sourcenodes_def)
thus ?thesis
proof
assume "n' = n" thus ?thesis by(rule sym)
next
assume "n' ∈ set(sourcenodes asi')"
with asx' ns' have "n' ∈ set ns'" by(simp add:sourcenodes_def)
with all have False by blast
thus ?thesis by simp
qed
qed
qed
lemma postdominate_path_branch:
assumes "n -as→* n''" and "n' postdominates n''" and "¬ n' postdominates n"
obtains a as' as'' where "as = as'@a#as''" and "valid_edge a"
and "¬ n' postdominates (sourcenode a)" and "n' postdominates (targetnode a)"
proof(atomize_elim)
from assms
show "∃as' a as''. as = as'@a#as'' ∧ valid_edge a ∧
¬ n' postdominates (sourcenode a) ∧ n' postdominates (targetnode a)"
proof(induct rule:path.induct)
case (Cons_path n'' as nx a n)
note IH = ‹⟦n' postdominates nx; ¬ n' postdominates n''⟧
⟹ ∃as' a as''. as = as'@a#as'' ∧ valid_edge a ∧
¬ n' postdominates sourcenode a ∧ n' postdominates targetnode a›
show ?case
proof(cases "n' postdominates n''")
case True
with ‹¬ n' postdominates n› ‹sourcenode a = n› ‹targetnode a = n''›
‹valid_edge a›
show ?thesis by blast
next
case False
from IH[OF ‹n' postdominates nx› this] show ?thesis
by clarsimp(rule_tac x="a#as'" in exI,clarsimp)
qed
qed simp
qed
lemma Exit_no_postdominator:
"(_Exit_) postdominates n ⟹ False"
by(fastforce dest:Exit_path simp:postdominate_def)
lemma postdominate_path_targetnode:
assumes "n' postdominates n" and "n -as→* n''" and "n' ∉ set(sourcenodes as)"
shows "n' postdominates n''"
proof -
from ‹n' postdominates n› have "valid_node n" and "valid_node n'"
and all:"∀as''. n -as''→* (_Exit_) ⟶ n' ∈ set(sourcenodes as'')"
by(simp_all add:postdominate_def)
from ‹n -as→* n''› have "valid_node n''" by(fastforce dest:path_valid_node)
have "∀as''. n'' -as''→* (_Exit_) ⟶ n' ∈ set(sourcenodes as'')"
proof(rule ccontr)
assume "¬ (∀as''. n'' -as''→* (_Exit_) ⟶ n' ∈ set (sourcenodes as''))"
then obtain as'' where "n'' -as''→* (_Exit_)"
and "n' ∉ set (sourcenodes as'')" by blast
from ‹n -as→* n''› ‹n'' -as''→* (_Exit_)› have "n -as@as''→* (_Exit_)"
by(rule path_Append)
with ‹n' ∉ set(sourcenodes as)› ‹n' ∉ set (sourcenodes as'')›
have "n' ∉ set (sourcenodes (as@as''))"
by(simp add:sourcenodes_def)
with ‹n -as@as''→* (_Exit_)› ‹n' postdominates n› show False
by(simp add:postdominate_def)
qed
with ‹valid_node n'› ‹valid_node n''› show ?thesis by(simp add:postdominate_def)
qed
lemma not_postdominate_source_not_postdominate_target:
assumes "¬ n postdominates (sourcenode a)" and "valid_node n" and "valid_edge a"
obtains ax where "sourcenode a = sourcenode ax" and "valid_edge ax"
and "¬ n postdominates targetnode ax"
proof(atomize_elim)
show "∃ax. sourcenode a = sourcenode ax ∧ valid_edge ax ∧
¬ n postdominates targetnode ax"
proof -
from assms obtain asx
where "sourcenode a -asx→* (_Exit_)"
and "n ∉ set(sourcenodes asx)" by(auto simp:postdominate_def)
from ‹sourcenode a -asx→* (_Exit_)› ‹valid_edge a›
obtain ax asx' where [simp]:"asx = ax#asx'"
apply - apply(erule path.cases)
apply(drule_tac s="(_Exit_)" in sym)
apply simp
apply(drule Exit_source)
by simp_all
with ‹sourcenode a -asx→* (_Exit_)› have "sourcenode a -[]@ax#asx'→* (_Exit_)"
by simp
hence "valid_edge ax" and "sourcenode a = sourcenode ax"
and "targetnode ax -asx'→* (_Exit_)"
by(fastforce dest:path_split)+
with ‹n ∉ set(sourcenodes asx)› have "¬ n postdominates targetnode ax"
by(fastforce simp:postdominate_def sourcenodes_def)
with ‹sourcenode a = sourcenode ax› ‹valid_edge ax› show ?thesis by blast
qed
qed
lemma inner_node_Entry_edge:
assumes "inner_node n"
obtains a where "valid_edge a" and "inner_node (targetnode a)"
and "sourcenode a = (_Entry_)"
proof(atomize_elim)
from ‹inner_node n› have "valid_node n" by(rule inner_is_valid)
then obtain as where "(_Entry_) -as→* n" by(fastforce dest:Entry_path)
show "∃a. valid_edge a ∧ inner_node (targetnode a) ∧ sourcenode a = (_Entry_)"
proof(cases "as = []")
case True
with ‹inner_node n› ‹(_Entry_) -as→* n› have False
by(fastforce simp:inner_node_def)
thus ?thesis by simp
next
case False
with ‹(_Entry_) -as→* n› obtain a' as' where "as = a'#as'"
and "(_Entry_) = sourcenode a'" and "valid_edge a'"
and "targetnode a' -as'→* n"
by -(erule path_split_Cons)
from ‹valid_edge a'› have "valid_node (targetnode a')" by simp
thus ?thesis
proof(cases "targetnode a'" rule:valid_node_cases)
case Entry
from ‹valid_edge a'› this have False by(rule Entry_target)
thus ?thesis by simp
next
case Exit
with ‹targetnode a' -as'→* n› ‹inner_node n›
have False by simp (drule path_Exit_source,auto simp:inner_node_def)
thus ?thesis by simp
next
case inner
with ‹valid_edge a'› ‹(_Entry_) = sourcenode a'› show ?thesis by simp blast
qed
qed
qed
lemma inner_node_Exit_edge:
assumes "inner_node n"
obtains a where "valid_edge a" and "inner_node (sourcenode a)"
and "targetnode a = (_Exit_)"
proof(atomize_elim)
from ‹inner_node n› have "valid_node n" by(rule inner_is_valid)
then obtain as where "n -as→* (_Exit_)" by(fastforce dest:Exit_path)
show "∃a. valid_edge a ∧ inner_node (sourcenode a) ∧ targetnode a = (_Exit_)"
proof(cases "as = []")
case True
with ‹inner_node n› ‹n -as→* (_Exit_)› have False by fastforce
thus ?thesis by simp
next
case False
with ‹n -as→* (_Exit_)› obtain a' as' where "as = as'@[a']"
and "n -as'→* sourcenode a'" and "valid_edge a'"
and "(_Exit_) = targetnode a'" by -(erule path_split_snoc)
from ‹valid_edge a'› have "valid_node (sourcenode a')" by simp
thus ?thesis
proof(cases "sourcenode a'" rule:valid_node_cases)
case Entry
with ‹n -as'→* sourcenode a'› ‹inner_node n›
have False by simp (drule path_Entry_target,auto simp:inner_node_def)
thus ?thesis by simp
next
case Exit
from ‹valid_edge a'› this have False by(rule Exit_source)
thus ?thesis by simp
next
case inner
with ‹valid_edge a'› ‹(_Exit_) = targetnode a'› show ?thesis by simp blast
qed
qed
qed
end
subsection ‹Strong Postdomination›
locale StrongPostdomination =
Postdomination sourcenode targetnode kind valid_edge Entry Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Exit :: "'node" ("'('_Exit'_')") +
assumes successor_set_finite: "valid_node n ⟹
finite {n'. ∃a'. valid_edge a' ∧ sourcenode a' = n ∧ targetnode a' = n'}"
begin
definition strong_postdominate :: "'node ⇒ 'node ⇒ bool"
("_ strongly-postdominates _" [51,0])
where strong_postdominate_def:"n' strongly-postdominates n ≡
(n' postdominates n ∧
(∃k ≥ 1. ∀as nx. n -as→* nx ∧
length as ≥ k ⟶ n' ∈ set(sourcenodes as)))"
lemma strong_postdominate_prop_smaller_path:
assumes all:"∀as nx. n -as→* nx ∧ length as ≥ k ⟶ n' ∈ set(sourcenodes as)"
and "n -as→* n''" and "length as ≥ k"
obtains as' as'' where "n -as'→* n'" and "length as' < k" and "n' -as''→* n''"
and "as = as'@as''"
proof(atomize_elim)
show "∃as' as''. n -as'→* n' ∧ length as' < k ∧ n' -as''→* n'' ∧ as = as'@as''"
proof(rule ccontr)
assume "¬ (∃as' as''. n -as'→* n' ∧ length as' < k ∧ n' -as''→* n'' ∧
as = as'@as'')"
hence all':"∀as' as''. n -as'→* n' ∧ n' -as''→* n'' ∧ as = as'@as''
⟶ length as' ≥ k" by fastforce
from all ‹n -as→* n''› ‹length as ≥ k› have "∃nx ∈ set(sourcenodes as). nx = n'"
by fastforce
then obtain ns ns' where "sourcenodes as = ns@n'#ns'"
and "∀nx ∈ set ns. nx ≠ n'"
by(fastforce elim!:split_list_first_propE)
then obtain asx a asx' where [simp]:"ns = sourcenodes asx"
and [simp]:"as = asx@a#asx'" and "sourcenode a = n'"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹n -as→* n''› have "n -asx@a#asx'→* n''" by simp
with ‹sourcenode a = n'› have "n -asx→* n'" and "valid_edge a"
and "targetnode a -asx'→* n''" by(fastforce dest:path_split)+
with ‹sourcenode a = n'› have "n' -a#asx'→* n''" by(fastforce intro:Cons_path)
with ‹n -asx→* n'› all' have "length asx ≥ k" by simp
with ‹n -asx→* n'› all have "n' ∈ set(sourcenodes asx)" by fastforce
with ‹∀nx ∈ set ns. nx ≠ n'› show False by fastforce
qed
qed
lemma strong_postdominate_refl:
assumes "valid_node n" and "n ≠ (_Exit_)"
shows "n strongly-postdominates n"
proof -
from assms have "n postdominates n" by(rule postdominate_refl)
{ fix as nx assume "n -as→* nx" and "length as ≥ 1"
then obtain a' as' where [simp]:"as = a'#as'" by(cases as) auto
with ‹n -as→* nx› have "n -[]@a'#as'→* nx" by simp
hence "n = sourcenode a'" by(fastforce dest:path_split)
hence "n ∈ set(sourcenodes as)" by(simp add:sourcenodes_def) }
hence "∀as nx. n -as→* nx ∧ length as ≥ 1 ⟶ n ∈ set(sourcenodes as)"
by auto
hence "∃k ≥ 1. ∀as nx. n -as→* nx ∧ length as ≥ k ⟶ n ∈ set(sourcenodes as)"
by blast
with ‹n postdominates n› show ?thesis by(simp add:strong_postdominate_def)
qed
lemma strong_postdominate_trans:
assumes "n'' strongly-postdominates n" and "n' strongly-postdominates n''"
shows "n' strongly-postdominates n"
proof -
from ‹n'' strongly-postdominates n› have "n'' postdominates n"
and paths1:"∃k ≥ 1. ∀as nx. n -as→* nx ∧ length as ≥ k
⟶ n'' ∈ set(sourcenodes as)"
by(auto simp only:strong_postdominate_def)
from paths1 obtain k1
where all1:"∀as nx. n -as→* nx ∧ length as ≥ k1 ⟶ n'' ∈ set(sourcenodes as)"
and "k1 ≥ 1" by blast
from ‹n' strongly-postdominates n''› have "n' postdominates n''"
and paths2:"∃k ≥ 1. ∀as nx. n'' -as→* nx ∧ length as ≥ k
⟶ n' ∈ set(sourcenodes as)"
by(auto simp only:strong_postdominate_def)
from paths2 obtain k2
where all2:"∀as nx. n'' -as→* nx ∧ length as ≥ k2 ⟶ n' ∈ set(sourcenodes as)"
and "k2 ≥ 1" by blast
from ‹n'' postdominates n› ‹n' postdominates n''›
have "n' postdominates n" by(rule postdominate_trans)
{ fix as nx assume "n -as→* nx" and "length as ≥ k1 + k2"
hence "length as ≥ k1" by fastforce
with ‹n -as→* nx› all1 obtain asx asx' where "n -asx→* n''"
and "length asx < k1" and "n'' -asx'→* nx"
and [simp]:"as = asx@asx'" by -(erule strong_postdominate_prop_smaller_path)
with ‹length as ≥ k1 + k2› have "length asx' ≥ k2" by fastforce
with ‹n'' -asx'→* nx› all2 have "n' ∈ set(sourcenodes asx')" by fastforce
hence "n' ∈ set(sourcenodes as)" by(simp add:sourcenodes_def) }
with ‹k1 ≥ 1› ‹k2 ≥ 1› have "∃k ≥ 1. ∀as nx. n -as→* nx ∧ length as ≥ k
⟶ n' ∈ set(sourcenodes as)"
by(rule_tac x="k1 + k2" in exI,auto)
with ‹n' postdominates n› show ?thesis by(simp add:strong_postdominate_def)
qed
lemma strong_postdominate_antisym:
"⟦n' strongly-postdominates n; n strongly-postdominates n'⟧ ⟹ n = n'"
by(fastforce intro:postdominate_antisym simp:strong_postdominate_def)
lemma strong_postdominate_path_branch:
assumes "n -as→* n''" and "n' strongly-postdominates n''"
and "¬ n' strongly-postdominates n"
obtains a as' as'' where "as = as'@a#as''" and "valid_edge a"
and "¬ n' strongly-postdominates (sourcenode a)"
and "n' strongly-postdominates (targetnode a)"
proof(atomize_elim)
from assms
show "∃as' a as''. as = as'@a#as'' ∧ valid_edge a ∧
¬ n' strongly-postdominates (sourcenode a) ∧
n' strongly-postdominates (targetnode a)"
proof(induct rule:path.induct)
case (Cons_path n'' as nx a n)
note IH = ‹⟦n' strongly-postdominates nx; ¬ n' strongly-postdominates n''⟧
⟹ ∃as' a as''. as = as'@a#as'' ∧ valid_edge a ∧
¬ n' strongly-postdominates sourcenode a ∧
n' strongly-postdominates targetnode a›
show ?case
proof(cases "n' strongly-postdominates n''")
case True
with ‹¬ n' strongly-postdominates n› ‹sourcenode a = n› ‹targetnode a = n''›
‹valid_edge a›
show ?thesis by blast
next
case False
from IH[OF ‹n' strongly-postdominates nx› this] show ?thesis
by clarsimp(rule_tac x="a#as'" in exI,clarsimp)
qed
qed simp
qed
lemma Exit_no_strong_postdominator:
"⟦(_Exit_) strongly-postdominates n; n -as→* (_Exit_)⟧ ⟹ False"
by(fastforce intro:Exit_no_postdominator path_valid_node simp:strong_postdominate_def)
lemma strong_postdominate_path_targetnode:
assumes "n' strongly-postdominates n" and "n -as→* n''"
and "n' ∉ set(sourcenodes as)"
shows "n' strongly-postdominates n''"
proof -
from ‹n' strongly-postdominates n› have "n' postdominates n"
and "∃k ≥ 1. ∀as nx. n -as→* nx ∧ length as ≥ k
⟶ n' ∈ set(sourcenodes as)"
by(auto simp only:strong_postdominate_def)
then obtain k where "k ≥ 1"
and paths:"∀as nx. n -as→* nx ∧ length as ≥ k
⟶ n' ∈ set(sourcenodes as)" by auto
from ‹n' postdominates n› ‹n -as→* n''› ‹n' ∉ set(sourcenodes as)›
have "n' postdominates n''"
by(rule postdominate_path_targetnode)
{ fix as' nx assume "n'' -as'→* nx" and "length as' ≥ k"
with ‹n -as→* n''› have "n -as@as'→* nx" and "length (as@as') ≥ k"
by(auto intro:path_Append)
with paths have "n' ∈ set(sourcenodes (as@as'))" by fastforce
with ‹n' ∉ set(sourcenodes as)› have "n' ∈ set(sourcenodes as')"
by(fastforce simp:sourcenodes_def) }
with ‹k ≥ 1› have "∃k ≥ 1. ∀as' nx. n'' -as'→* nx ∧ length as' ≥ k
⟶ n' ∈ set(sourcenodes as')" by auto
with ‹n' postdominates n''› show ?thesis by(simp add:strong_postdominate_def)
qed
lemma not_strong_postdominate_successor_set:
assumes "¬ n strongly-postdominates (sourcenode a)" and "valid_node n"
and "valid_edge a"
and all:"∀nx ∈ N. ∃a'. valid_edge a' ∧ sourcenode a' = sourcenode a ∧
targetnode a' = nx ∧ n strongly-postdominates nx"
obtains a' where "valid_edge a'" and "sourcenode a' = sourcenode a"
and "targetnode a' ∉ N"
proof(atomize_elim)
show "∃a'. valid_edge a' ∧ sourcenode a' = sourcenode a ∧ targetnode a' ∉ N"
proof(cases "n postdominates (sourcenode a)")
case False
with ‹valid_edge a› ‹valid_node n›
obtain a' where [simp]:"sourcenode a = sourcenode a'"
and "valid_edge a'" and "¬ n postdominates targetnode a'"
by -(erule not_postdominate_source_not_postdominate_target)
with all have "targetnode a' ∉ N" by(auto simp:strong_postdominate_def)
with ‹valid_edge a'› show ?thesis by simp blast
next
case True
let ?M = "{n'. ∃a'. valid_edge a' ∧ sourcenode a' = sourcenode a ∧
targetnode a' = n'}"
let ?M' = "{n'. ∃a'. valid_edge a' ∧ sourcenode a' = sourcenode a ∧
targetnode a' = n' ∧ n strongly-postdominates n'}"
let ?N' = "(λn'. SOME i. i ≥ 1 ∧
(∀as nx. n' -as→* nx ∧ length as ≥ i
⟶ n ∈ set(sourcenodes as))) ` N"
obtain k where [simp]:"k = Max ?N'" by simp
have eq:"{x ∈ ?M. (λn'. n strongly-postdominates n') x} = ?M'" by auto
from ‹valid_edge a› have "finite ?M" by(simp add:successor_set_finite)
hence "finite {x ∈ ?M. (λn'. n strongly-postdominates n') x}" by fastforce
with eq have "finite ?M'" by simp
from all have "N ⊆ ?M'" by auto
with ‹finite ?M'› have "finite N" by(auto intro:finite_subset)
hence "finite ?N'" by fastforce
show ?thesis
proof(rule ccontr)
assume "¬ (∃a'. valid_edge a' ∧ sourcenode a' = sourcenode a ∧
targetnode a' ∉ N)"
hence allImp:"∀a'. valid_edge a' ∧ sourcenode a' = sourcenode a
⟶ targetnode a' ∈ N" by blast
from True ‹¬ n strongly-postdominates (sourcenode a)›
have allPaths:"∀k ≥ 1. ∃as nx. sourcenode a -as→* nx ∧ length as ≥ k
∧ n ∉ set(sourcenodes as)" by(auto simp:strong_postdominate_def)
then obtain as nx where "sourcenode a -as→* nx"
and "length as ≥ k + 1" and "n ∉ set(sourcenodes as)"
by (erule_tac x="k + 1" in allE) auto
then obtain ax as' where [simp]:"as = ax#as'" and "valid_edge ax"
and "sourcenode ax = sourcenode a" and "targetnode ax -as'→* nx"
by -(erule path.cases,auto)
with allImp have "targetnode ax ∈ N" by fastforce
with all have "n strongly-postdominates (targetnode ax)"
by auto
then obtain k' where k':"k' = (SOME i. i ≥ 1 ∧
(∀as nx. targetnode ax -as→* nx ∧ length as ≥ i
⟶ n ∈ set(sourcenodes as)))" by simp
with ‹n strongly-postdominates (targetnode ax)›
have "k' ≥ 1 ∧ (∀as nx. targetnode ax -as→* nx ∧ length as ≥ k'
⟶ n ∈ set(sourcenodes as))"
by(auto elim!:someI_ex simp:strong_postdominate_def)
hence "k' ≥ 1"
and spdAll:"∀as nx. targetnode ax -as→* nx ∧ length as ≥ k'
⟶ n ∈ set(sourcenodes as)"
by simp_all
from ‹targetnode ax ∈ N› k' have "k' ∈ ?N'" by blast
with ‹targetnode ax ∈ N› have "?N' ≠ {}" by auto
with ‹k' ∈ ?N'› have "k' ≤ Max ?N'" using ‹finite ?N'› by(fastforce intro:Max_ge)
hence "k' ≤ k" by simp
with ‹targetnode ax -as'→* nx› ‹length as ≥ k + 1› spdAll
have "n ∈ set(sourcenodes as')"
by fastforce
with ‹n ∉ set(sourcenodes as)› show False by(simp add:sourcenodes_def)
qed
qed
qed
lemma not_strong_postdominate_predecessor_successor:
assumes "¬ n strongly-postdominates (sourcenode a)"
and "valid_node n" and "valid_edge a"
obtains a' where "valid_edge a'" and "sourcenode a' = sourcenode a"
and "¬ n strongly-postdominates (targetnode a')"
proof(atomize_elim)
show "∃a'. valid_edge a' ∧ sourcenode a' = sourcenode a ∧
¬ n strongly-postdominates (targetnode a')"
proof(rule ccontr)
assume "¬ (∃a'. valid_edge a' ∧ sourcenode a' = sourcenode a ∧
¬ n strongly-postdominates targetnode a')"
hence all:"∀a'. valid_edge a' ∧ sourcenode a' = sourcenode a ⟶
n strongly-postdominates (targetnode a')" by auto
let ?N = "{n'. ∃a'. sourcenode a' = sourcenode a ∧ valid_edge a' ∧
targetnode a' = n'}"
from all have "∀nx ∈ ?N. ∃a'. valid_edge a' ∧ sourcenode a' = sourcenode a ∧
targetnode a' = nx ∧ n strongly-postdominates nx"
by auto
with assms obtain a' where "valid_edge a'"
and "sourcenode a' = sourcenode a" and "targetnode a' ∉ ?N"
by(erule not_strong_postdominate_successor_set)
thus False by auto
qed
qed
end
end
Theory CFG_wf
section ‹CFG well-formedness›
theory CFG_wf imports CFG begin
subsection ‹Well-formedness of the abstract CFG›
locale CFG_wf = CFG sourcenode targetnode kind valid_edge Entry
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") +
fixes Def::"'node ⇒ 'var set"
fixes Use::"'node ⇒ 'var set"
fixes state_val::"'state ⇒ 'var ⇒ 'val"
assumes Entry_empty:"Def (_Entry_) = {} ∧ Use (_Entry_) = {}"
and CFG_edge_no_Def_equal:
"⟦valid_edge a; V ∉ Def (sourcenode a); pred (kind a) s⟧
⟹ state_val (transfer (kind a) s) V = state_val s V"
and CFG_edge_transfer_uses_only_Use:
"⟦valid_edge a; ∀V ∈ Use (sourcenode a). state_val s V = state_val s' V;
pred (kind a) s; pred (kind a) s'⟧
⟹ ∀V ∈ Def (sourcenode a). state_val (transfer (kind a) s) V =
state_val (transfer (kind a) s') V"
and CFG_edge_Uses_pred_equal:
"⟦valid_edge a; pred (kind a) s;
∀V ∈ Use (sourcenode a). state_val s V = state_val s' V⟧
⟹ pred (kind a) s'"
and deterministic:"⟦valid_edge a; valid_edge a'; sourcenode a = sourcenode a';
targetnode a ≠ targetnode a'⟧
⟹ ∃Q Q'. kind a = (Q)⇩√ ∧ kind a' = (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
begin
lemma [dest!]: "V ∈ Use (_Entry_) ⟹ False"
by(simp add:Entry_empty)
lemma [dest!]: "V ∈ Def (_Entry_) ⟹ False"
by(simp add:Entry_empty)
lemma CFG_path_no_Def_equal:
"⟦n -as→* n'; ∀n ∈ set (sourcenodes as). V ∉ Def n; preds (kinds as) s⟧
⟹ state_val (transfers (kinds as) s) V = state_val s V"
proof(induct arbitrary:s rule:path.induct)
case (empty_path n)
thus ?case by(simp add:sourcenodes_def kinds_def)
next
case (Cons_path n'' as n' a n)
note IH = ‹⋀s. ⟦∀n∈set (sourcenodes as). V ∉ Def n; preds (kinds as) s⟧ ⟹
state_val (transfers (kinds as) s) V = state_val s V›
from ‹preds (kinds (a#as)) s› have "pred (kind a) s"
and "preds (kinds as) (transfer (kind a) s)" by(simp_all add:kinds_def)
from ‹∀n∈set (sourcenodes (a#as)). V ∉ Def n›
have noDef:"V ∉ Def (sourcenode a)"
and all:"∀n∈set (sourcenodes as). V ∉ Def n"
by(auto simp:sourcenodes_def)
from ‹valid_edge a› noDef ‹pred (kind a) s›
have "state_val (transfer (kind a) s) V = state_val s V"
by(rule CFG_edge_no_Def_equal)
with IH[OF all ‹preds (kinds as) (transfer (kind a) s)›] show ?case
by(simp add:kinds_def)
qed
end
end
Theory CFGExit_wf
theory CFGExit_wf imports CFGExit CFG_wf begin
subsection ‹New well-formedness lemmas using ‹(_Exit_)››
locale CFGExit_wf =
CFG_wf sourcenode targetnode kind valid_edge Entry Def Use state_val +
CFGExit sourcenode targetnode kind valid_edge Entry Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val"
and Exit :: "'node" ("'('_Exit'_')") +
assumes Exit_empty:"Def (_Exit_) = {} ∧ Use (_Exit_) = {}"
begin
lemma Exit_Use_empty [dest!]: "V ∈ Use (_Exit_) ⟹ False"
by(simp add:Exit_empty)
lemma Exit_Def_empty [dest!]: "V ∈ Def (_Exit_) ⟹ False"
by(simp add:Exit_empty)
end
end
Theory SemanticsCFG
section ‹CFG and semantics conform›
theory SemanticsCFG imports CFG begin
locale CFG_semantics_wf = CFG sourcenode targetnode kind valid_edge Entry
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") +
fixes sem::"'com ⇒ 'state ⇒ 'com ⇒ 'state ⇒ bool"
("((1⟨_,/_⟩) ⇒/ (1⟨_,/_⟩))" [0,0,0,0] 81)
fixes identifies::"'node ⇒ 'com ⇒ bool" ("_ ≜ _" [51,0] 80)
assumes fundamental_property:
"⟦n ≜ c; ⟨c,s⟩ ⇒ ⟨c',s'⟩⟧ ⟹
∃n' as. n -as→* n' ∧ transfers (kinds as) s = s' ∧ preds (kinds as) s ∧
n' ≜ c'"
end
Theory DynDataDependence
section ‹Dynamic data dependence›
theory DynDataDependence imports CFG_wf begin
context CFG_wf begin
definition dyn_data_dependence ::
"'node ⇒ 'var ⇒ 'node ⇒ 'edge list ⇒ bool" ("_ influences _ in _ via _" [51,0,0])
where "n influences V in n' via as ≡
((V ∈ Def n) ∧ (V ∈ Use n') ∧ (n -as→* n') ∧
(∃a' as'. (as = a'#as') ∧ (∀n'' ∈ set (sourcenodes as'). V ∉ Def n'')))"
lemma dyn_influence_Cons_source:
"n influences V in n' via a#as ⟹ sourcenode a = n"
by(simp add:dyn_data_dependence_def,auto elim:path.cases)
lemma dyn_influence_source_notin_tl_edges:
assumes "n influences V in n' via a#as"
shows "n ∉ set (sourcenodes as)"
proof(rule ccontr)
assume "¬ n ∉ set (sourcenodes as)"
hence "n ∈ set (sourcenodes as)" by simp
from ‹n influences V in n' via a#as› have "∀n'' ∈ set (sourcenodes as). V ∉ Def n''"
and "V ∈ Def n" by(simp_all add:dyn_data_dependence_def)
from ‹∀n'' ∈ set (sourcenodes as). V ∉ Def n''›
‹n ∈ set (sourcenodes as)› have "V ∉ Def n" by simp
with ‹V ∈ Def n› show False by simp
qed
lemma dyn_influence_only_first_edge:
assumes "n influences V in n' via a#as" and "preds (kinds (a#as)) s"
shows "state_val (transfers (kinds (a#as)) s) V =
state_val (transfer (kind a) s) V"
proof -
from ‹preds (kinds (a#as)) s› have "preds (kinds as) (transfer (kind a) s)"
by(simp add:kinds_def)
from ‹n influences V in n' via a#as› have "n -a#as→* n'"
and "∀n'' ∈ set (sourcenodes as). V ∉ Def n''"
by(simp_all add:dyn_data_dependence_def)
from ‹n -a#as→* n'› have "n = sourcenode a" and "targetnode a -as→* n'"
by(auto elim:path_split_Cons)
from ‹n influences V in n' via a#as› ‹n = sourcenode a›
have "sourcenode a ∉ set (sourcenodes as)"
by(fastforce intro!:dyn_influence_source_notin_tl_edges)
{ fix n'' assume "n'' ∈ set (sourcenodes as)"
with ‹sourcenode a ∉ set (sourcenodes as)› ‹n = sourcenode a›
have "n'' ≠ n" by(fastforce simp:sourcenodes_def)
with ‹∀n'' ∈ set (sourcenodes as). V ∉ Def n''› ‹n'' ∈ set (sourcenodes as)›
have "V ∉ Def n''" by(auto simp:sourcenodes_def) }
hence "∀n'' ∈ set (sourcenodes as). V ∉ Def n''" by simp
with ‹targetnode a -as→* n'› ‹preds (kinds as) (transfer (kind a) s)›
have "state_val (transfers (kinds as) (transfer (kind a) s)) V =
state_val (transfer (kind a) s) V"
by -(rule CFG_path_no_Def_equal)
thus ?thesis by(auto simp:kinds_def)
qed
end
end
Theory DynStandardControlDependence
section ‹Dynamic Standard Control Dependence›
theory DynStandardControlDependence imports Postdomination begin
context Postdomination begin
definition
dyn_standard_control_dependence :: "'node ⇒ 'node ⇒ 'edge list ⇒ bool"
("_ controls⇩s _ via _" [51,0,0])
where dyn_standard_control_dependence_def:"n controls⇩s n' via as ≡
(∃a a' as'. (as = a#as') ∧ (n' ∉ set(sourcenodes as)) ∧ (n -as→* n') ∧
(n' postdominates (targetnode a)) ∧
(valid_edge a') ∧ (sourcenode a' = n) ∧
(¬ n' postdominates (targetnode a')))"
lemma Exit_not_dyn_standard_control_dependent:
assumes control:"n controls⇩s (_Exit_) via as" shows "False"
proof -
from control obtain a as' where path:"n -as→* (_Exit_)" and as:"as = a#as'"
and pd:"(_Exit_) postdominates (targetnode a)"
by(auto simp:dyn_standard_control_dependence_def)
from path as have "n -[]@a#as'→* (_Exit_)" by simp
hence "valid_edge a" by(fastforce dest:path_split)
with pd show False by -(rule Exit_no_postdominator,auto)
qed
lemma dyn_standard_control_dependence_def_variant:
"n controls⇩s n' via as = ((n -as→* n') ∧ (n ≠ n') ∧
(¬ n' postdominates n) ∧ (n' ∉ set(sourcenodes as)) ∧
(∀n'' ∈ set(targetnodes as). n' postdominates n''))"
proof
assume "(n -as→* n') ∧ (n ≠ n') ∧ (¬ n' postdominates n) ∧
(n' ∉ set(sourcenodes as)) ∧
(∀n''∈set (targetnodes as). n' postdominates n'')"
hence path:"n -as→* n'" and noteq:"n ≠ n'"
and not_pd:"¬ n' postdominates n"
and notin:"n' ∉ set(sourcenodes as)"
and all:"∀n''∈set (targetnodes as). n' postdominates n''"
by auto
have notExit:"n ≠ (_Exit_)"
proof
assume "n = (_Exit_)"
with path have "n = n'" by(fastforce dest:path_Exit_source)
with noteq show False by simp
qed
from path have valid:"valid_node n" and valid':"valid_node n'"
by(auto dest:path_valid_node)
show "n controls⇩s n' via as"
proof(cases as)
case Nil
with path valid not_pd notExit have False
by(fastforce elim:path.cases dest:postdominate_refl)
thus ?thesis by simp
next
case (Cons ax asx)
with all have pd:"n' postdominates targetnode ax"
by(auto simp:targetnodes_def)
from path Cons have source:"n = sourcenode ax"
and path2:"targetnode ax -asx→* n'"
by(auto intro:path_split_Cons)
show ?thesis
proof(cases "∃as'. n -as'→* (_Exit_)")
case True
with not_pd valid valid' obtain as' where path':"n -as'→* (_Exit_)"
and not_isin:"n' ∉ set (sourcenodes as')"
by(auto simp:postdominate_def)
have "as' ≠ []"
proof
assume "as' = []"
with path' have "n = (_Exit_)" by(auto elim:path.cases)
with notExit show False by simp
qed
then obtain a' as'' where as':"as' = a'#as''"
by(cases as',auto elim:path.cases)
with path' have "n -[]@a'#as''→* (_Exit_)" by simp
hence source':"n = sourcenode a'"
and valid_edge:"valid_edge a'"
and path2':"targetnode a' -as''→* (_Exit_)"
by(fastforce dest:path_split)+
from path2' not_isin as' valid'
have "¬ n' postdominates (targetnode a')"
by(auto simp:postdominate_def sourcenodes_def)
with pd path Cons source source' notin valid_edge show ?thesis
by(auto simp:dyn_standard_control_dependence_def)
next
case False
with valid valid' have "n' postdominates n"
by(auto simp:postdominate_def)
with not_pd have False by simp
thus ?thesis by simp
qed
qed
next
assume "n controls⇩s n' via as"
then obtain a nx a' nx' as' where notin:"n' ∉ set(sourcenodes as)"
and path:"n -as→* n'" and as:"as = a#as'" and valid_edge:"valid_edge a'"
and pd:"n' postdominates (targetnode a)"
and source':"sourcenode a' = n"
and not_pd:"¬ n' postdominates (targetnode a')"
by(auto simp:dyn_standard_control_dependence_def)
from path as have source:"sourcenode a = n" by(auto elim:path.cases)
from path as have notExit:"n ≠ (_Exit_)" by(auto elim:path.cases)
from path have valid:"valid_node n" and valid':"valid_node n'"
by(auto dest:path_valid_node)
from notin as source have noteq:"n ≠ n'"
by(fastforce simp:sourcenodes_def)
from valid_edge have valid_target':"valid_node (targetnode a')"
by(fastforce simp:valid_node_def)
{ assume pd':"n' postdominates n"
hence all:"∀as. n -as→* (_Exit_) ⟶ n' ∈ set (sourcenodes as)"
by(auto simp:postdominate_def)
from not_pd valid' valid_target' obtain as'
where "targetnode a' -as'→* (_Exit_)"
by(auto simp:postdominate_def)
with source' valid_edge have path':"n -a'#as'→* (_Exit_)"
by(fastforce intro:Cons_path)
with all have "n' ∈ set (sourcenodes (a'#as'))" by blast
with source' have "n' = n ∨ n' ∈ set (sourcenodes as')"
by(fastforce simp:sourcenodes_def)
hence False
proof
assume "n' = n"
with noteq show ?thesis by simp
next
assume isin:"n' ∈ set (sourcenodes as')"
from path' have path2:"targetnode a' -as'→* (_Exit_)"
by(fastforce elim:path_split_Cons)
thus ?thesis
proof(cases "as' = []")
case True
with path2 have "targetnode a' = (_Exit_)" by(auto elim:path.cases)
with valid_edge all source' have "n' = n"
by(fastforce dest:path_edge simp:sourcenodes_def)
with noteq show ?thesis by simp
next
case False
from path2 not_pd valid' valid_edge obtain as''
where path'':"targetnode a' -as''→* (_Exit_)"
and notin:"n' ∉ set (sourcenodes as'')"
by(auto simp:postdominate_def)
from valid_edge path'' have "sourcenode a' -a'#as''→* (_Exit_)"
by(fastforce intro:Cons_path)
with all source' have "n' ∈ set (sourcenodes ([a']@as''))" by simp
with source' have "n' = n ∨ n' ∈ set (sourcenodes as'')"
by(auto simp:sourcenodes_def)
thus ?thesis
proof
assume "n' = n"
with noteq show ?thesis by simp
next
assume "n' ∈ set (sourcenodes as'')"
with notin show ?thesis by simp
qed
qed
qed }
hence not_pd':"¬ n' postdominates n" by blast
{ fix n'' assume "n'' ∈ set (targetnodes as)"
with as source have "n'' = targetnode a ∨ n'' ∈ set (targetnodes as')"
by(auto simp:targetnodes_def)
hence "n' postdominates n''"
proof
assume "n'' = targetnode a"
with pd show ?thesis by simp
next
assume isin:"n'' ∈ set (targetnodes as')"
hence "∃ni ∈ set (targetnodes as'). ni = n''" by simp
then obtain ns ns' where targets:"targetnodes as' = ns@n''#ns'"
and all_noteq:"∀ni ∈ set ns'. ni ≠ n''"
by(fastforce elim!:rightmost_element_property)
from targets obtain xs ax ys where ys:"ns' = targetnodes ys"
and as':"as' = xs@ax#ys" and target'':"targetnode ax = n''"
by(fastforce elim:map_append_append_maps simp:targetnodes_def)
from all_noteq ys have notin_target:"n'' ∉ set(targetnodes ys)"
by auto
from path as have "n -[]@a#as'→* n'" by simp
hence "targetnode a -as'→* n'"
by(fastforce dest:path_split)
with isin have path':"targetnode a -as'→* n'"
by(fastforce split:if_split_asm simp:targetnodes_def)
with as' target'' have path1:"targetnode a -xs→* sourcenode ax"
and valid_edge':"valid_edge ax"
and path2:"n'' -ys→* n'"
by(auto intro:path_split)
from valid_edge' have "sourcenode ax -[ax]→* targetnode ax" by(rule path_edge)
with path1 target'' have path_n'':"targetnode a -xs@[ax]→* n''"
by(fastforce intro:path_Append)
from notin as as' have notin':"n'∉ set (sourcenodes (xs@[ax]))"
by(simp add:sourcenodes_def)
show ?thesis
proof(rule ccontr)
assume "¬ n' postdominates n''"
with valid' target'' valid_edge' obtain asx'
where Exit_path:"n'' -asx'→* (_Exit_)"
and notin'':"n' ∉ set(sourcenodes asx')" by(auto simp:postdominate_def)
from path_n'' Exit_path
have Exit_path':"targetnode a -(xs@[ax])@asx'→* (_Exit_)"
by(fastforce intro:path_Append)
from notin' notin'' have "n' ∉ set(sourcenodes (xs@ax#asx'))"
by(simp add:sourcenodes_def)
with pd Exit_path' show False by(simp add:postdominate_def)
qed
qed }
with path not_pd' notin noteq show "(n -as→* n') ∧ (n ≠ n') ∧
(¬ n' postdominates n) ∧ (n' ∉ set(sourcenodes as)) ∧
(∀n'' ∈ set(targetnodes as). n' postdominates n'')" by blast
qed
lemma which_node_dyn_standard_control_dependence_source:
assumes path:"(_Entry_) -as@a#as'→* n"
and Exit_path:"n -as''→* (_Exit_)" and source:"sourcenode a = n'"
and source':"sourcenode a' = n'"
and no_source:"n ∉ set(sourcenodes (a#as'))" and valid_edge':"valid_edge a'"
and inner_node:"inner_node n" and not_pd:"¬ n postdominates (targetnode a')"
and last:"∀ax ax'. ax ∈ set as' ∧ sourcenode ax = sourcenode ax' ∧
valid_edge ax' ⟶ n postdominates targetnode ax'"
shows "n' controls⇩s n via a#as'"
proof -
from path source have path_n'n:"n' -a#as'→* n" by(fastforce dest:path_split_second)
from path have valid_edge:"valid_edge a" by(fastforce intro:path_split)
show ?thesis
proof(cases "n postdominates (targetnode a)")
case True
with path_n'n not_pd no_source source source' valid_edge' show ?thesis
by(auto simp:dyn_standard_control_dependence_def)
next
case False
hence not_pd':"¬ n postdominates (targetnode a)" .
show ?thesis
proof(cases "as' = []")
case True
with path_n'n have "targetnode a = n" by(fastforce elim:path.cases)
with inner_node have "n postdominates (targetnode a)"
by(cases "n = (_Exit_)",auto intro:postdominate_refl simp:inner_node_def)
with not_pd path_n'n no_source source source' valid_edge' show ?thesis
by(fastforce simp:dyn_standard_control_dependence_def)
next
case False
hence notempty':"as' ≠ []" .
with path have path_nxn:"targetnode a -as'→* n"
by(fastforce dest:path_split)
from Exit_path path_nxn have "∃as. targetnode a -as→* (_Exit_)"
by(fastforce dest:path_Append)
with not_pd' inner_node valid_edge obtain asx
where path_Exit:"targetnode a -asx→* (_Exit_)"
and notin:"n ∉ set (sourcenodes asx)"
by(auto simp:postdominate_def inner_is_valid)
show ?thesis
proof(cases "∃asx'. asx = as'@asx'")
case True
then obtain asx' where asx:"asx = as'@asx'" by blast
from path notempty' have "targetnode a -as'→* n"
by(fastforce dest:path_split)
with path_Exit inner_node asx notempty'
obtain a'' as'' where "asx' = a''#as'' ∧ sourcenode a'' = n"
apply(cases asx')
apply(fastforce dest:path_det)
by(fastforce dest:path_split path_det)
with asx have "n ∈ set(sourcenodes asx)" by(simp add:sourcenodes_def)
with notin have False by simp
thus ?thesis by simp
next
case False
hence all:"∀asx'. asx ≠ as'@asx'" by simp
then obtain j asx' where asx:"asx = (take j as')@asx'"
and length:"j < length as'"
and not_more:"∀k > j. ∀asx''. asx ≠ (take k as')@asx''"
by(auto elim:path_split_general)
from asx length have "∃as'1 as'2. asx = as'1@asx' ∧
as' = as'1@as'2 ∧ as'2 ≠ [] ∧ as'1 = take j as'"
by simp(rule_tac x= "drop j as'" in exI,simp)
then obtain as'1 as'' where asx:"asx = as'1@asx'"
and take:"as'1 = take j as'"
and x:"as' = as'1@as''" and x':"as'' ≠ []" by blast
from x x' obtain a1 as'2 where as':"as' = as'1@a1#as'2" and "as'' = a1#as'2"
by(cases as'') auto
have notempty_x':"asx' ≠ []"
proof(cases "asx' = []")
case True
with asx as' have "as' = asx@a1#as'2" by simp
with path_n'n have "n' -(a#asx)@a1#as'2→* n"
by simp
hence "n' -a#asx→* sourcenode a1"
and valid_edge1:"valid_edge a1" by(fastforce elim:path_split)+
hence "targetnode a -asx→* sourcenode a1"
by(fastforce intro:path_split_Cons)
with path_Exit have "(_Exit_) = sourcenode a1" by(rule path_det)
from this[THEN sym] valid_edge1 have False by -(rule Exit_source,simp_all)
thus ?thesis by simp
qed simp
with asx obtain a2 asx'1
where asx:"asx = as'1@a2#asx'1"
and asx':"asx' = a2#asx'1" by(cases asx') auto
from path_n'n as' have "n' -(a#as'1)@a1#as'2→* n" by simp
hence "n' -a#as'1→* sourcenode a1" and valid_edge1:"valid_edge a1"
by(fastforce elim:path_split)+
hence path1:"targetnode a -as'1→* sourcenode a1"
by(fastforce intro:path_split_Cons)
from path_Exit asx
have "targetnode a -as'1→* sourcenode a2"
and valid_edge2:"valid_edge a2"
and path2:"targetnode a2 -asx'1→* (_Exit_)"
by(auto intro:path_split)
with path1 have eq12:"sourcenode a1 = sourcenode a2"
by(cases as'1,auto dest:path_det)
from asx notin have "n ∉ set (sourcenodes asx'1)"
by(simp add:sourcenodes_def)
with path2 have not_pd'2:"¬ n postdominates targetnode a2"
by(cases "asx'1 = []",auto simp:postdominate_def)
from as' have "a1 ∈ set as'" by simp
with eq12 last valid_edge2 have "n postdominates targetnode a2" by blast
with not_pd'2 have False by simp
thus ?thesis by simp
qed
qed
qed
qed
lemma inner_node_dyn_standard_control_dependence_predecessor:
assumes inner_node:"inner_node n"
obtains n' as where "n' controls⇩s n via as"
proof(atomize_elim)
from inner_node obtain as' where pathExit:"n -as'→* (_Exit_)"
by(fastforce dest:inner_is_valid Exit_path)
from inner_node obtain as where pathEntry:"(_Entry_) -as→* n"
by(fastforce dest:inner_is_valid Entry_path)
with inner_node have notEmpty:"as ≠ []"
by(auto elim:path.cases simp:inner_node_def)
have "∃a asx. (_Entry_) -a#asx→* n ∧ n ∉ set (sourcenodes (a#asx))"
proof(cases "n ∈ set (sourcenodes as)")
case True
hence "∃n'' ∈ set(sourcenodes as). n = n''" by simp
then obtain ns' ns'' where nodes:"sourcenodes as = ns'@n#ns''"
and notin:"∀n'' ∈ set ns'. n ≠ n''"
by(fastforce elim!:split_list_first_propE)
from nodes obtain xs ys a'
where xs:"sourcenodes xs = ns'" and as:"as = xs@a'#ys"
and source:"sourcenode a' = n"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from pathEntry as have "(_Entry_) -xs@a'#ys→* n" by simp
hence path2:"(_Entry_) -xs→* sourcenode a'"
by(fastforce dest:path_split)
show ?thesis
proof(cases "xs = []")
case True
with path2 have "(_Entry_) = sourcenode a'" by(auto elim:path.cases)
with pathEntry source notEmpty have "(_Entry_) -as→* (_Entry_) ∧ as ≠ []"
by(auto elim:path.cases)
hence False by(fastforce dest:path_Entry_target)
thus ?thesis by simp
next
case False
then obtain n a'' xs' where "xs = a''#xs'" by(cases xs) auto
with False path2 notin xs source show ?thesis by simp blast
qed
next
case False
from notEmpty obtain a as' where "as = a#as'" by (cases as) auto
with False pathEntry show ?thesis by auto
qed
then obtain a asx where pathEntry':"(_Entry_) -a#asx→* n"
and notin:"n ∉ set (sourcenodes (a#asx))" by blast
show "∃n' as. n' controls⇩s n via as"
proof(cases "∀a' a''. a' ∈ set asx ∧ sourcenode a' = sourcenode a'' ∧
valid_edge a'' ⟶ n postdominates targetnode a''")
case True
from inner_node have not_pd:"¬ n postdominates (_Exit_)"
by(fastforce intro:empty_path simp:postdominate_def sourcenodes_def)
from pathEntry' have path':"(_Entry_) -[]@a#asx→* n" by simp
hence eq:"sourcenode a = (_Entry_)"
by(fastforce dest:path_split elim:path.cases)
from Entry_Exit_edge obtain a' where "sourcenode a' = (_Entry_)"
and "targetnode a' = (_Exit_)" and "valid_edge a'" by auto
with path' inner_node not_pd True eq notin pathExit
have "sourcenode a controls⇩s n via a#asx"
by -(erule which_node_dyn_standard_control_dependence_source,auto)
thus ?thesis by blast
next
case False
hence "∃a' ∈ set asx. ∃a''. sourcenode a' = sourcenode a'' ∧ valid_edge a'' ∧
¬ n postdominates targetnode a''"
by fastforce
then obtain ax asx' asx'' where "asx = asx'@ax#asx'' ∧
(∃a''. sourcenode ax = sourcenode a'' ∧ valid_edge a'' ∧
¬ n postdominates targetnode a'') ∧
(∀z ∈ set asx''. ¬ (∃a''. sourcenode z = sourcenode a'' ∧ valid_edge a'' ∧
¬ n postdominates targetnode a''))"
by(blast elim!:rightmost_element_property)
then obtain a'' where as':"asx = asx'@ax#asx''"
and eq:"sourcenode ax = sourcenode a''"
and valid_edge:"valid_edge a''"
and not_pd:"¬ n postdominates targetnode a''"
and last:"∀z ∈ set asx''. ¬ (∃a''. sourcenode z = sourcenode a'' ∧
valid_edge a'' ∧ ¬ n postdominates targetnode a'')"
by blast
from notin as' have notin':"n ∉ set (sourcenodes (ax#asx''))"
by(auto simp:sourcenodes_def)
from as' pathEntry' have "(_Entry_) -(a#asx')@ax#asx''→* n" by simp
with inner_node not_pd notin' eq last pathExit valid_edge
have "sourcenode ax controls⇩s n via ax#asx''"
by(fastforce elim!:which_node_dyn_standard_control_dependence_source)
thus ?thesis by blast
qed
qed
end
end
Theory DynWeakControlDependence
section ‹Dynamic Weak Control Dependence›
theory DynWeakControlDependence imports Postdomination begin
context StrongPostdomination begin
definition
dyn_weak_control_dependence :: "'node ⇒ 'node ⇒ 'edge list ⇒ bool"
("_ weakly controls _ via _" [51,0,0])
where dyn_weak_control_dependence_def:"n weakly controls n' via as ≡
(∃a a' as'. (as = a#as') ∧ (n' ∉ set(sourcenodes as)) ∧ (n -as→* n') ∧
(n' strongly-postdominates (targetnode a)) ∧
(valid_edge a') ∧ (sourcenode a' = n) ∧
(¬ n' strongly-postdominates (targetnode a')))"
lemma Exit_not_dyn_weak_control_dependent:
assumes control:"n weakly controls (_Exit_) via as" shows "False"
proof -
from control obtain as a as' where path:"n -as→* (_Exit_)" and as:"as = a#as'"
and pd:"(_Exit_) postdominates (targetnode a)"
by(auto simp:dyn_weak_control_dependence_def strong_postdominate_def)
from path as have "n -[]@a#as'→* (_Exit_)" by simp
hence "valid_edge a" by(fastforce dest:path_split)
with pd show False by -(rule Exit_no_postdominator,auto)
qed
end
end
Theory DynPDG
chapter ‹Dynamic Slicing›
section ‹Dynamic Program Dependence Graph›
theory DynPDG imports
"../Basic/DynDataDependence"
"../Basic/CFGExit_wf"
"../Basic/DynStandardControlDependence"
"../Basic/DynWeakControlDependence"
begin
subsection ‹The dynamic PDG›
locale DynPDG =
CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val"
and Exit :: "'node" ("'('_Exit'_')") +
fixes dyn_control_dependence :: "'node ⇒ 'node ⇒ 'edge list ⇒ bool"
("_ controls _ via _" [51,0,0])
assumes Exit_not_dyn_control_dependent:"n controls n' via as ⟹ n' ≠ (_Exit_)"
assumes dyn_control_dependence_path:
"n controls n' via as ⟹ n -as→* n' ∧ as ≠ []"
begin
inductive cdep_edge :: "'node ⇒ 'edge list ⇒ 'node ⇒ bool"
("_ -_→⇩c⇩d _" [51,0,0] 80)
and ddep_edge :: "'node ⇒ 'var ⇒ 'edge list ⇒ 'node ⇒ bool"
("_ -'{_'}_→⇩d⇩d _" [51,0,0,0] 80)
and DynPDG_edge :: "'node ⇒ 'var option ⇒ 'edge list ⇒ 'node ⇒ bool"
where
"n -as→⇩c⇩d n' == DynPDG_edge n None as n'"
| "n -{V}as→⇩d⇩d n' == DynPDG_edge n (Some V) as n'"
| DynPDG_cdep_edge:
"n controls n' via as ⟹ n -as→⇩c⇩d n'"
| DynPDG_ddep_edge:
"n influences V in n' via as ⟹ n -{V}as→⇩d⇩d n'"
inductive DynPDG_path :: "'node ⇒ 'edge list ⇒ 'node ⇒ bool"
("_ -_→⇩d* _" [51,0,0] 80)
where DynPDG_path_Nil:
"valid_node n ⟹ n -[]→⇩d* n"
| DynPDG_path_Append_cdep:
"⟦n -as→⇩d* n''; n'' -as'→⇩c⇩d n'⟧ ⟹ n -as@as'→⇩d* n'"
| DynPDG_path_Append_ddep:
"⟦n -as→⇩d* n''; n'' -{V}as'→⇩d⇩d n'⟧ ⟹ n -as@as'→⇩d* n'"
lemma DynPDG_empty_path_eq_nodes:"n -[]→⇩d* n' ⟹ n = n'"
apply - apply(erule DynPDG_path.cases)
apply simp
apply(auto elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
lemma DynPDG_path_cdep:"n -as→⇩c⇩d n' ⟹ n -as→⇩d* n'"
apply(subgoal_tac "n -[]@as→⇩d* n'")
apply simp
apply(rule DynPDG_path_Append_cdep, rule DynPDG_path_Nil)
by(auto elim!:DynPDG_edge.cases dest:dyn_control_dependence_path path_valid_node)
lemma DynPDG_path_ddep:"n -{V}as→⇩d⇩d n' ⟹ n -as→⇩d* n'"
apply(subgoal_tac "n -[]@as→⇩d* n'")
apply simp
apply(rule DynPDG_path_Append_ddep, rule DynPDG_path_Nil)
by(auto elim!:DynPDG_edge.cases dest:path_valid_node simp:dyn_data_dependence_def)
lemma DynPDG_path_Append:
"⟦n'' -as'→⇩d* n'; n -as→⇩d* n''⟧ ⟹ n -as@as'→⇩d* n'"
apply(induct rule:DynPDG_path.induct)
apply(auto intro:DynPDG_path.intros)
apply(rotate_tac 1,drule DynPDG_path_Append_cdep,simp+)
apply(rotate_tac 1,drule DynPDG_path_Append_ddep,simp+)
done
lemma DynPDG_path_Exit:"⟦n -as→⇩d* n'; n' = (_Exit_)⟧ ⟹ n = (_Exit_)"
apply(induct rule:DynPDG_path.induct)
by(auto elim:DynPDG_edge.cases dest:Exit_not_dyn_control_dependent
simp:dyn_data_dependence_def)
lemma DynPDG_path_not_inner:
"⟦n -as→⇩d* n'; ¬ inner_node n'⟧ ⟹ n = n'"
proof(induct rule:DynPDG_path.induct)
case (DynPDG_path_Nil n)
thus ?case by simp
next
case (DynPDG_path_Append_cdep n as n'' as' n')
from ‹n'' -as'→⇩c⇩d n'› ‹¬ inner_node n'› have False
apply -
apply(erule DynPDG_edge.cases) apply(auto simp:inner_node_def)
apply(fastforce dest:dyn_control_dependence_path path_valid_node)
apply(fastforce dest:dyn_control_dependence_path path_valid_node)
by(fastforce dest:Exit_not_dyn_control_dependent)
thus ?case by simp
next
case (DynPDG_path_Append_ddep n as n'' V as' n')
from ‹n'' -{V}as'→⇩d⇩d n'› ‹¬ inner_node n'› have False
apply -
apply(erule DynPDG_edge.cases)
by(auto dest:path_valid_node simp:inner_node_def dyn_data_dependence_def)
thus ?case by simp
qed
lemma DynPDG_cdep_edge_CFG_path:
assumes "n -as→⇩c⇩d n'" shows "n -as→* n'" and "as ≠ []"
using ‹n -as→⇩c⇩d n'›
by(auto elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
lemma DynPDG_ddep_edge_CFG_path:
assumes "n -{V}as→⇩d⇩d n'" shows "n -as→* n'" and "as ≠ []"
using ‹n -{V}as→⇩d⇩d n'›
by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
lemma DynPDG_path_CFG_path:
"n -as→⇩d* n' ⟹ n -as→* n'"
proof(induct rule:DynPDG_path.induct)
case DynPDG_path_Nil thus ?case by(rule empty_path)
next
case (DynPDG_path_Append_cdep n as n'' as' n')
from ‹n'' -as'→⇩c⇩d n'› have "n'' -as'→* n'"
by(rule DynPDG_cdep_edge_CFG_path(1))
with ‹n -as→* n''› show ?case by(rule path_Append)
next
case (DynPDG_path_Append_ddep n as n'' V as' n')
from ‹n'' -{V}as'→⇩d⇩d n'› have "n'' -as'→* n'"
by(rule DynPDG_ddep_edge_CFG_path(1))
with ‹n -as→* n''› show ?case by(rule path_Append)
qed
lemma DynPDG_path_split:
"n -as→⇩d* n' ⟹
(as = [] ∧ n = n') ∨
(∃n'' asx asx'. (n -asx→⇩c⇩d n'') ∧ (n'' -asx'→⇩d* n') ∧
(as = asx@asx')) ∨
(∃n'' V asx asx'. (n -{V}asx→⇩d⇩d n'') ∧ (n'' -asx'→⇩d* n') ∧
(as = asx@asx'))"
proof(induct rule:DynPDG_path.induct)
case (DynPDG_path_Nil n) thus ?case by auto
next
case (DynPDG_path_Append_cdep n as n'' as' n')
note IH = ‹as = [] ∧ n = n'' ∨
(∃nx asx asx'. n -asx→⇩c⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx') ∨
(∃nx V asx asx'. n -{V}asx→⇩d⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx')›
from IH show ?case
proof
assume "as = [] ∧ n = n''"
with ‹n'' -as'→⇩c⇩d n'› have "valid_node n'"
by(fastforce intro:path_valid_node(2) DynPDG_path_CFG_path
DynPDG_path_cdep)
with ‹as = [] ∧ n = n''› ‹n'' -as'→⇩c⇩d n'›
have "∃n'' asx asx'. n -asx→⇩c⇩d n'' ∧ n'' -asx'→⇩d* n' ∧ as@as' = asx@asx'"
by(auto intro:DynPDG_path_Nil)
thus ?thesis by simp
next
assume "(∃nx asx asx'. n -asx→⇩c⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx') ∨
(∃nx V asx asx'. n -{V}asx→⇩d⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx')"
thus ?thesis
proof
assume "∃nx asx asx'. n -asx→⇩c⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx'"
then obtain nx asx asx' where "n -asx→⇩c⇩d nx" and "nx -asx'→⇩d* n''"
and "as = asx@asx'" by auto
from ‹n'' -as'→⇩c⇩d n'› have "n'' -as'→⇩d* n'" by(rule DynPDG_path_cdep)
with ‹nx -asx'→⇩d* n''› have "nx -asx'@as'→⇩d* n'"
by(fastforce intro:DynPDG_path_Append)
with ‹n -asx→⇩c⇩d nx› ‹as = asx@asx'›
have "∃n'' asx asx'. n -asx→⇩c⇩d n'' ∧ n'' -asx'→⇩d* n' ∧ as@as' = asx@asx'"
by auto
thus ?thesis by simp
next
assume "∃nx V asx asx'. n -{V}asx→⇩d⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx'"
then obtain nx V asx asx' where "n -{V}asx→⇩d⇩d nx" and "nx -asx'→⇩d* n''"
and "as = asx@asx'" by auto
from ‹n'' -as'→⇩c⇩d n'› have "n'' -as'→⇩d* n'" by(rule DynPDG_path_cdep)
with ‹nx -asx'→⇩d* n''› have "nx -asx'@as'→⇩d* n'"
by(fastforce intro:DynPDG_path_Append)
with ‹n -{V}asx→⇩d⇩d nx› ‹as = asx@asx'›
have "∃n'' V asx asx'. n -{V}asx→⇩d⇩d n'' ∧ n'' -asx'→⇩d* n' ∧ as@as' = asx@asx'"
by auto
thus ?thesis by simp
qed
qed
next
case (DynPDG_path_Append_ddep n as n'' V as' n')
note IH = ‹as = [] ∧ n = n'' ∨
(∃nx asx asx'. n -asx→⇩c⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx') ∨
(∃nx V asx asx'. n -{V}asx→⇩d⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx')›
from IH show ?case
proof
assume "as = [] ∧ n = n''"
with ‹n'' -{V}as'→⇩d⇩d n'› have "valid_node n'"
by(fastforce intro:path_valid_node(2) DynPDG_path_CFG_path
DynPDG_path_ddep)
with ‹as = [] ∧ n = n''› ‹n'' -{V}as'→⇩d⇩d n'›
have "∃n'' V asx asx'. n -{V}asx→⇩d⇩d n'' ∧ n'' -asx'→⇩d* n' ∧ as@as' = asx@asx'"
by(fastforce intro:DynPDG_path_Nil)
thus ?thesis by simp
next
assume "(∃nx asx asx'. n -asx→⇩c⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx') ∨
(∃nx V asx asx'. n -{V}asx→⇩d⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx')"
thus ?thesis
proof
assume "∃nx asx asx'. n -asx→⇩c⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx'"
then obtain nx asx asx' where "n -asx→⇩c⇩d nx" and "nx -asx'→⇩d* n''"
and "as = asx@asx'" by auto
from ‹n'' -{V}as'→⇩d⇩d n'› have "n'' -as'→⇩d* n'" by(rule DynPDG_path_ddep)
with ‹nx -asx'→⇩d* n''› have "nx -asx'@as'→⇩d* n'"
by(fastforce intro:DynPDG_path_Append)
with ‹n -asx→⇩c⇩d nx› ‹as = asx@asx'›
have "∃n'' asx asx'. n -asx→⇩c⇩d n'' ∧ n'' -asx'→⇩d* n' ∧ as@as' = asx@asx'"
by auto
thus ?thesis by simp
next
assume "∃nx V asx asx'. n -{V}asx→⇩d⇩d nx ∧ nx -asx'→⇩d* n'' ∧ as = asx@asx'"
then obtain nx V' asx asx' where "n -{V'}asx→⇩d⇩d nx" and "nx -asx'→⇩d* n''"
and "as = asx@asx'" by auto
from ‹n'' -{V}as'→⇩d⇩d n'› have "n'' -as'→⇩d* n'" by(rule DynPDG_path_ddep)
with ‹nx -asx'→⇩d* n''› have "nx -asx'@as'→⇩d* n'"
by(fastforce intro:DynPDG_path_Append)
with ‹n -{V'}asx→⇩d⇩d nx› ‹as = asx@asx'›
have "∃n'' V asx asx'. n -{V}asx→⇩d⇩d n'' ∧ n'' -asx'→⇩d* n' ∧ as@as' = asx@asx'"
by auto
thus ?thesis by simp
qed
qed
qed
lemma DynPDG_path_rev_cases [consumes 1,
case_names DynPDG_path_Nil DynPDG_path_cdep_Append DynPDG_path_ddep_Append]:
"⟦n -as→⇩d* n'; ⟦as = []; n = n'⟧ ⟹ Q;
⋀n'' asx asx'. ⟦n -asx→⇩c⇩d n''; n'' -asx'→⇩d* n';
as = asx@asx'⟧ ⟹ Q;
⋀V n'' asx asx'. ⟦n -{V}asx→⇩d⇩d n''; n'' -asx'→⇩d* n';
as = asx@asx'⟧ ⟹ Q⟧
⟹ Q"
by(blast dest:DynPDG_path_split)
lemma DynPDG_ddep_edge_no_shorter_ddep_edge:
assumes ddep:"n -{V}as→⇩d⇩d n'"
shows "∀as' a as''. tl as = as'@a#as'' ⟶ ¬ sourcenode a -{V}a#as''→⇩d⇩d n'"
proof -
from ddep have influence:"n influences V in n' via as"
by(auto elim!:DynPDG_edge.cases)
then obtain a asx where as:"as = a#asx"
and notin:"n ∉ set (sourcenodes asx)"
by(auto dest:dyn_influence_source_notin_tl_edges simp:dyn_data_dependence_def)
from influence as
have imp:"∀nx ∈ set (sourcenodes asx). V ∉ Def nx"
by(auto simp:dyn_data_dependence_def)
{ fix as' a' as''
assume eq:"tl as = as'@a'#as''"
and ddep':"sourcenode a' -{V}a'#as''→⇩d⇩d n'"
from eq as notin have noteq:"sourcenode a' ≠ n" by(auto simp:sourcenodes_def)
from ddep' have "V ∈ Def (sourcenode a')"
by(auto elim!:DynPDG_edge.cases simp:dyn_data_dependence_def)
with eq as noteq imp have False by(auto simp:sourcenodes_def) }
thus ?thesis by blast
qed
lemma no_ddep_same_state:
assumes path:"n -as→* n'" and Uses:"V ∈ Use n'" and preds:"preds (kinds as) s"
and no_dep:"∀as' a as''. as = as'@a#as'' ⟶ ¬ sourcenode a -{V}a#as''→⇩d⇩d n'"
shows "state_val (transfers (kinds as) s) V = state_val s V"
proof -
{ fix n''
assume inset:"n'' ∈ set (sourcenodes as)" and Defs:"V ∈ Def n''"
hence "∃nx ∈ set (sourcenodes as). V ∈ Def nx" by auto
then obtain nx ns' ns'' where nodes:"sourcenodes as = ns'@nx#ns''"
and Defs':"V ∈ Def nx" and notDef:"∀nx' ∈ set ns''. V ∉ Def nx'"
by(fastforce elim!:rightmost_element_property)
from nodes obtain as' a as''
where as'':"sourcenodes as'' = ns''" and as:"as=as'@a#as''"
and source:"sourcenode a = nx"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from as path have path':"sourcenode a -a#as''→* n'"
by(fastforce dest:path_split_second)
from notDef as'' source
have "∀n'' ∈ set (sourcenodes as''). V ∉ Def n''"
by(auto simp:sourcenodes_def)
with path' Defs' Uses source
have influence:"nx influences V in n' via (a#as'')"
by(simp add:dyn_data_dependence_def)
hence "nx ∉ set (sourcenodes as'')" by(rule dyn_influence_source_notin_tl_edges)
with influence source
have "∃asx a'. sourcenode a' -{V}a'#asx→⇩d⇩d n' ∧ sourcenode a' = nx ∧
(∃asx'. a#as'' = asx'@a'#asx)"
by(fastforce intro:DynPDG_ddep_edge)
with nodes no_dep as have False by(auto simp:sourcenodes_def) }
hence "∀n ∈ set (sourcenodes as). V ∉ Def n" by auto
with wf path preds show ?thesis by(fastforce intro:CFG_path_no_Def_equal)
qed
lemma DynPDG_ddep_edge_only_first_edge:
"⟦n -{V}a#as→⇩d⇩d n'; preds (kinds (a#as)) s⟧ ⟹
state_val (transfers (kinds (a#as)) s) V = state_val (transfer (kind a) s) V"
apply -
apply(erule DynPDG_edge.cases)
apply auto
apply(frule dyn_influence_Cons_source)
apply(frule dyn_influence_source_notin_tl_edges)
by(erule dyn_influence_only_first_edge)
lemma Use_value_change_implies_DynPDG_ddep_edge:
assumes "n -as→* n'" and "V ∈ Use n'" and "preds (kinds as) s"
and "preds (kinds as) s'" and "state_val s V = state_val s' V"
and "state_val (transfers (kinds as) s) V ≠
state_val (transfers (kinds as) s') V"
obtains as' a as'' where "as = as'@a#as''"
and "sourcenode a -{V}a#as''→⇩d⇩d n'"
and "state_val (transfers (kinds as) s) V =
state_val (transfers (kinds (as'@[a])) s) V"
and "state_val (transfers (kinds as) s') V =
state_val (transfers (kinds (as'@[a])) s') V"
proof(atomize_elim)
show "∃as' a as''. as = as'@a#as'' ∧
sourcenode a -{V}a#as''→⇩d⇩d n' ∧
state_val (transfers (kinds as) s) V =
state_val (transfers (kinds (as'@[a])) s) V ∧
state_val (transfers (kinds as) s') V =
state_val (transfers (kinds (as'@[a])) s') V"
proof(cases "∀as' a as''. as = as'@a#as'' ⟶
¬ sourcenode a -{V}a#as''→⇩d⇩d n'")
case True
with ‹n -as→* n'› ‹V ∈ Use n'› ‹preds (kinds as) s› ‹preds (kinds as) s'›
have "state_val (transfers (kinds as) s) V = state_val s V"
and "state_val (transfers (kinds as) s') V = state_val s' V"
by(auto intro:no_ddep_same_state)
with ‹state_val s V = state_val s' V›
‹state_val (transfers (kinds as) s) V ≠ state_val (transfers (kinds as) s') V›
show ?thesis by simp
next
case False
then obtain as' a as'' where [simp]:"as = as'@a#as''"
and "sourcenode a -{V}a#as''→⇩d⇩d n'" by auto
from ‹preds (kinds as) s› have "preds (kinds (a#as'')) (transfers (kinds as') s)"
by(simp add:kinds_def preds_split)
with ‹sourcenode a -{V}a#as''→⇩d⇩d n'› have all:
"state_val (transfers (kinds (a#as'')) (transfers (kinds as') s)) V =
state_val (transfer (kind a) (transfers (kinds as') s)) V"
by(auto dest!:DynPDG_ddep_edge_only_first_edge)
from ‹preds (kinds as) s'›
have "preds (kinds (a#as'')) (transfers (kinds as') s')"
by(simp add:kinds_def preds_split)
with ‹sourcenode a -{V}a#as''→⇩d⇩d n'› have all':
"state_val (transfers (kinds (a#as'')) (transfers (kinds as') s')) V =
state_val (transfer (kind a) (transfers (kinds as') s')) V"
by(auto dest!:DynPDG_ddep_edge_only_first_edge)
hence eq:"⋀s. transfers (kinds as) s =
transfers (kinds (a#as'')) (transfers (kinds as') s)"
by(simp add:transfers_split[THEN sym] kinds_def)
with all have "state_val (transfers (kinds as) s) V =
state_val (transfers (kinds (as'@[a])) s) V"
by(simp add:transfers_split kinds_def)
moreover
from eq all' have "state_val (transfers (kinds as) s') V =
state_val (transfers (kinds (as'@[a])) s') V"
by(simp add:transfers_split kinds_def)
ultimately show ?thesis using ‹sourcenode a -{V}a#as''→⇩d⇩d n'› by simp blast
qed
qed
end
subsection ‹Instantiate dynamic PDG›
subsubsection ‹Standard control dependence›
locale DynStandardControlDependencePDG =
Postdomination sourcenode targetnode kind valid_edge Entry Exit +
CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val"
and Exit :: "'node" ("'('_Exit'_')")
begin
lemma DynPDG_scd:
"DynPDG sourcenode targetnode kind valid_edge (_Entry_)
Def Use state_val (_Exit_) dyn_standard_control_dependence"
proof(unfold_locales)
fix n n' as assume "n controls⇩s n' via as"
show "n' ≠ (_Exit_)"
proof
assume "n' = (_Exit_)"
with ‹n controls⇩s n' via as› show False
by(fastforce intro:Exit_not_dyn_standard_control_dependent)
qed
next
fix n n' as assume "n controls⇩s n' via as"
thus "n -as→* n' ∧ as ≠ []"
by(fastforce simp:dyn_standard_control_dependence_def)
qed
end
subsubsection ‹Weak control dependence›
locale DynWeakControlDependencePDG =
StrongPostdomination sourcenode targetnode kind valid_edge Entry Exit +
CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val"
and Exit :: "'node" ("'('_Exit'_')")
begin
lemma DynPDG_wcd:
"DynPDG sourcenode targetnode kind valid_edge (_Entry_)
Def Use state_val (_Exit_) dyn_weak_control_dependence"
proof(unfold_locales)
fix n n' as assume "n weakly controls n' via as"
show "n' ≠ (_Exit_)"
proof
assume "n' = (_Exit_)"
with ‹n weakly controls n' via as› show False
by(fastforce intro:Exit_not_dyn_weak_control_dependent)
qed
next
fix n n' as assume "n weakly controls n' via as"
thus "n -as→* n' ∧ as ≠ []"
by(fastforce simp:dyn_weak_control_dependence_def)
qed
end
subsection ‹Data slice›
definition (in CFG) empty_control_dependence :: "'node ⇒ 'node ⇒ 'edge list ⇒ bool"
where "empty_control_dependence n n' as ≡ False"
lemma (in CFGExit_wf) DynPDG_scd:
"DynPDG sourcenode targetnode kind valid_edge (_Entry_)
Def Use state_val (_Exit_) empty_control_dependence"
proof(unfold_locales)
fix n n' as assume "empty_control_dependence n n' as"
thus "n' ≠ (_Exit_)" by(simp add:empty_control_dependence_def)
next
fix n n' as assume "empty_control_dependence n n' as"
thus "n -as→* n' ∧ as ≠ []" by(simp add:empty_control_dependence_def)
qed
end
Theory DependentLiveVariables
section ‹Dependent Live Variables›
theory DependentLiveVariables imports DynPDG begin
text ‹‹dependent_live_vars› calculates variables which
can change\\ the value of the @{term Use} variables of the target node›
context DynPDG begin
inductive_set
dependent_live_vars :: "'node ⇒ ('var × 'edge list × 'edge list) set"
for n' :: "'node"
where dep_vars_Use:
"V ∈ Use n' ⟹ (V,[],[]) ∈ dependent_live_vars n'"
| dep_vars_Cons_cdep:
"⟦V ∈ Use (sourcenode a); sourcenode a -a#as'→⇩c⇩d n''; n'' -as''→⇩d* n'⟧
⟹ (V,[],a#as'@as'') ∈ dependent_live_vars n'"
| dep_vars_Cons_ddep:
"⟦(V,as',as) ∈ dependent_live_vars n'; V' ∈ Use (sourcenode a);
n' = last(targetnodes (a#as));
sourcenode a -{V}a#as'→⇩d⇩d last(targetnodes (a#as'))⟧
⟹ (V',[],a#as) ∈ dependent_live_vars n'"
| dep_vars_Cons_keep:
"⟦(V,as',as) ∈ dependent_live_vars n'; n' = last(targetnodes (a#as));
¬ sourcenode a -{V}a#as'→⇩d⇩d last(targetnodes (a#as'))⟧
⟹ (V,a#as',a#as) ∈ dependent_live_vars n'"
lemma dependent_live_vars_fst_prefix_snd:
"(V,as',as) ∈ dependent_live_vars n' ⟹ ∃as''. as'@as'' = as"
by(induct rule:dependent_live_vars.induct,simp_all)
lemma dependent_live_vars_Exit_empty [dest]:
"(V,as',as) ∈ dependent_live_vars (_Exit_) ⟹ False"
proof(induct rule:dependent_live_vars.induct)
case (dep_vars_Cons_cdep V a as' n'' as'')
from ‹n'' -as''→⇩d* (_Exit_)› have "n'' = (_Exit_)"
by(fastforce intro:DynPDG_path_Exit)
with ‹sourcenode a -a#as'→⇩c⇩d n''› have "sourcenode a -a#as'→⇩d* (_Exit_)"
by(fastforce intro:DynPDG_path_cdep)
hence "sourcenode a = (_Exit_)" by(fastforce intro:DynPDG_path_Exit)
with ‹V ∈ Use (sourcenode a)› show False by simp(erule Exit_Use_empty)
qed auto
lemma dependent_live_vars_lastnode:
"⟦(V,as',as) ∈ dependent_live_vars n'; as ≠ []⟧
⟹ n' = last(targetnodes as)"
proof(induct rule:dependent_live_vars.induct)
case (dep_vars_Cons_cdep V a as' n'' as'')
from ‹sourcenode a -a#as'→⇩c⇩d n''› have "sourcenode a -a#as'→* n''"
by(rule DynPDG_cdep_edge_CFG_path(1))
from ‹n'' -as''→⇩d* n'› have "n'' -as''→* n'" by(rule DynPDG_path_CFG_path)
show ?case
proof(cases "as'' = []")
case True
with ‹n'' -as''→* n'› have "n'' = n'" by (auto elim: DynPDG.dependent_live_vars.cases)
with ‹sourcenode a -a#as'→* n''› True
show ?thesis by(fastforce intro:path_targetnode[THEN sym])
next
case False
with ‹n'' -as''→* n'› have "n' = last(targetnodes as'')"
by(fastforce intro:path_targetnode[THEN sym])
with False show ?thesis by(fastforce simp:targetnodes_def)
qed
qed simp_all
lemma dependent_live_vars_Use_cases:
"⟦(V,as',as) ∈ dependent_live_vars n'; n -as→* n'⟧
⟹ ∃nx as''. as = as'@as'' ∧ n -as'→* nx ∧ nx -as''→⇩d* n' ∧ V ∈ Use nx ∧
(∀n'' ∈ set (sourcenodes as'). V ∉ Def n'')"
proof(induct arbitrary:n rule:dependent_live_vars.induct)
case (dep_vars_Use V)
from ‹n -[]→* n'› have "valid_node n'" by(rule path_valid_node(2))
hence "n' -[]→⇩d* n'" by(rule DynPDG_path_Nil)
with ‹V ∈ Use n'› ‹n -[]→* n'› show ?case
by(auto simp:sourcenodes_def)
next
case (dep_vars_Cons_cdep V a as' n'' as'' n)
from ‹n -a#as'@as''→* n'› have "sourcenode a = n"
by(auto elim:path.cases)
from ‹sourcenode a -a#as'→⇩c⇩d n''› have "sourcenode a -a#as'→* n''"
by(rule DynPDG_cdep_edge_CFG_path(1))
hence "valid_edge a" by(auto elim:path.cases)
hence "sourcenode a -[]→* sourcenode a" by(fastforce intro:empty_path)
from ‹sourcenode a -a#as'→⇩c⇩d n''› have "sourcenode a -a#as'→⇩d* n''"
by(rule DynPDG_path_cdep)
with ‹n'' -as''→⇩d* n'› have "sourcenode a -(a#as')@as''→⇩d* n'"
by(rule DynPDG_path_Append)
with ‹sourcenode a -[]→* sourcenode a› ‹V ∈ Use (sourcenode a)› ‹sourcenode a = n›
show ?case by(auto simp:sourcenodes_def)
next
case(dep_vars_Cons_ddep V as' as V' a n)
note ddep = ‹sourcenode a -{V}a#as'→⇩d⇩d last (targetnodes (a#as'))›
note IH = ‹⋀n. n -as→* n'
⟹ ∃nx as''. as = as'@as'' ∧ n -as'→* nx ∧ nx -as''→⇩d* n' ∧
V ∈ Use nx ∧ (∀n''∈set (sourcenodes as'). V ∉ Def n'')›
from ‹n -a#as→* n'› have "n -[]@a#as→* n'" by simp
hence "n = sourcenode a" and "targetnode a -as→* n'" and "valid_edge a"
by(fastforce dest:path_split)+
hence "n -[]→* n"
by(fastforce intro:empty_path simp:valid_node_def)
from IH[OF ‹targetnode a -as→* n'›]
have "∃nx as''. as = as'@as'' ∧ targetnode a -as'→* nx ∧ nx -as''→⇩d* n' ∧
V ∈ Use nx ∧ (∀n''∈set (sourcenodes as'). V ∉ Def n'')" .
then obtain nx'' as'' where "targetnode a -as'→* nx''"
and "nx'' -as''→⇩d* n'" and "as = as'@as''" by blast
have "last (targetnodes (a#as')) -as''→⇩d* n'"
proof(cases as')
case Nil
with ‹targetnode a -as'→* nx''› have "nx'' = targetnode a"
by(auto elim:path.cases)
with ‹nx'' -as''→⇩d* n'› Nil show ?thesis by(simp add:targetnodes_def)
next
case (Cons ax asx)
hence "last (targetnodes (a#as')) = last (targetnodes as')"
by(simp add:targetnodes_def)
from Cons ‹targetnode a -as'→* nx''› have "last (targetnodes as') = nx''"
by(fastforce intro:path_targetnode)
with ‹last (targetnodes (a#as')) = last (targetnodes as')› ‹nx'' -as''→⇩d* n'›
show ?thesis by simp
qed
with ddep ‹as = as'@as''› have "sourcenode a -a#as→⇩d* n'"
by(fastforce dest:DynPDG_path_ddep DynPDG_path_Append)
with ‹V' ∈ Use (sourcenode a)› ‹n = sourcenode a› ‹n -[]→* n›
show ?case by(auto simp:sourcenodes_def)
next
case (dep_vars_Cons_keep V as' as a n)
note no_dep = ‹¬ sourcenode a -{V}a#as'→⇩d⇩d last (targetnodes (a#as'))›
note IH = ‹⋀n. n -as→* n'
⟹ ∃nx as''. (as = as'@as'') ∧ (n -as'→* nx) ∧ (nx -as''→⇩d* n') ∧
V ∈ Use nx ∧ (∀n''∈set (sourcenodes as'). V ∉ Def n'')›
from ‹n -a#as→* n'› have "n = sourcenode a" and "valid_edge a"
and "targetnode a -as→* n'" by(auto elim:path_split_Cons)
from IH[OF ‹targetnode a -as→* n'›]
have "∃nx as''. as = as'@as'' ∧ targetnode a -as'→* nx ∧ nx -as''→⇩d* n' ∧
V ∈ Use nx ∧ (∀n''∈set (sourcenodes as'). V ∉ Def n'')" .
then obtain nx'' as'' where "V ∈ Use nx''"
and "∀n''∈set (sourcenodes as'). V ∉ Def n''" and "targetnode a -as'→* nx''"
and "nx'' -as''→⇩d* n'" and "as = as'@as''" by blast
from ‹valid_edge a› ‹targetnode a -as'→* nx''› have "sourcenode a -a#as'→* nx''"
by(fastforce intro:Cons_path)
hence "last(targetnodes (a#as')) = nx''" by(fastforce dest:path_targetnode)
{ assume "V ∈ Def (sourcenode a)"
with ‹V ∈ Use nx''› ‹sourcenode a -a#as'→* nx''›
‹∀n''∈set (sourcenodes as'). V ∉ Def n''›
have "(sourcenode a) influences V in nx'' via a#as'"
by(simp add:dyn_data_dependence_def sourcenodes_def)
with no_dep ‹last(targetnodes (a#as')) = nx''›
‹∀n''∈set (sourcenodes as'). V ∉ Def n''› ‹V ∈ Def (sourcenode a)›
have False by(fastforce dest:DynPDG_ddep_edge) }
with ‹∀n''∈set (sourcenodes as'). V ∉ Def n''›
have "∀n''∈set (sourcenodes (a#as')). V ∉ Def n''"
by(fastforce simp:sourcenodes_def)
with ‹V ∈ Use nx''› ‹sourcenode a -a#as'→* nx''› ‹nx'' -as''→⇩d* n'›
‹as = as'@as''› ‹n = sourcenode a› show ?case by fastforce
qed
lemma dependent_live_vars_dependent_edge:
assumes "(V,as',as) ∈ dependent_live_vars n'"
and "targetnode a -as→* n'"
and "V ∈ Def (sourcenode a)" and "valid_edge a"
obtains nx as'' where "as = as'@as''" and "sourcenode a -{V}a#as'→⇩d⇩d nx"
and "nx -as''→⇩d* n'"
proof(atomize_elim)
from ‹(V,as',as) ∈ dependent_live_vars n'› ‹targetnode a -as→* n'›
have "∃nx as''. as = as'@as'' ∧ targetnode a -as'→* nx ∧ nx -as''→⇩d* n' ∧
V ∈ Use nx ∧ (∀n'' ∈ set (sourcenodes as'). V ∉ Def n'')"
by(rule dependent_live_vars_Use_cases)
then obtain nx as'' where "V ∈ Use nx"
and "∀n''∈ set(sourcenodes as'). V ∉ Def n''"
and "targetnode a -as'→* nx" and "nx -as''→⇩d* n'"
and "as = as'@as''" by blast
from ‹targetnode a -as'→* nx› ‹valid_edge a› have "sourcenode a -a#as'→* nx"
by(fastforce intro:Cons_path)
with ‹V ∈ Def (sourcenode a)› ‹V ∈ Use nx›
‹∀n''∈ set(sourcenodes as'). V ∉ Def n''›
have "sourcenode a influences V in nx via a#as'"
by(auto simp:dyn_data_dependence_def sourcenodes_def)
hence "sourcenode a -{V}a#as'→⇩d⇩d nx" by(rule DynPDG_ddep_edge)
with ‹nx -as''→⇩d* n'› ‹as = as'@as''›
show "∃as'' nx. (as = as'@as'') ∧ (sourcenode a -{V}a#as'→⇩d⇩d nx) ∧
(nx -as''→⇩d* n')" by fastforce
qed
lemma dependent_live_vars_same_pathsI:
assumes "V ∈ Use n'"
shows "⟦∀as' a as''. as = as'@a#as'' ⟶ ¬ sourcenode a -{V}a#as''→⇩d⇩d n';
as ≠ [] ⟶ n' = last(targetnodes as)⟧
⟹ (V,as,as) ∈ dependent_live_vars n'"
proof(induct as)
case Nil
from ‹V ∈ Use n'› show ?case by(rule dep_vars_Use)
next
case (Cons ax asx)
note lastnode = ‹ax#asx ≠ [] ⟶ n' = last (targetnodes (ax#asx))›
note IH = ‹⟦∀as' a as''. asx = as'@a#as'' ⟶
¬ sourcenode a -{V}a#as''→⇩d⇩d n';
asx ≠ [] ⟶ n' = last (targetnodes asx)⟧
⟹ (V, asx, asx) ∈ dependent_live_vars n'›
from ‹∀as' a as''. ax#asx = as'@a#as'' ⟶ ¬ sourcenode a -{V}a#as''→⇩d⇩d n'›
have all':"∀as' a as''. asx = as'@a#as'' ⟶ ¬ sourcenode a -{V}a#as''→⇩d⇩d n'"
and "¬ sourcenode ax -{V}ax#asx→⇩d⇩d n'"
by simp_all
show ?case
proof(cases "asx = []")
case True
from ‹V ∈ Use n'› have "(V,[],[]) ∈ dependent_live_vars n'" by(rule dep_vars_Use)
with ‹¬ sourcenode ax -{V}ax#asx→⇩d⇩d n'› True lastnode
have "(V,[ax],[ax]) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_keep)
with True show ?thesis by simp
next
case False
with lastnode have "asx ≠ [] ⟶ n' = last (targetnodes asx)"
by(simp add:targetnodes_def)
from IH[OF all' this] have "(V, asx, asx) ∈ dependent_live_vars n'" .
with ‹¬ sourcenode ax -{V}ax#asx→⇩d⇩d n'› lastnode
show ?thesis by(fastforce intro:dep_vars_Cons_keep)
qed
qed
lemma dependent_live_vars_same_pathsD:
"⟦(V,as,as) ∈ dependent_live_vars n'; as ≠ [] ⟶ n' = last(targetnodes as)⟧
⟹ V ∈ Use n' ∧ (∀as' a as''. as = as'@a#as'' ⟶
¬ sourcenode a -{V}a#as''→⇩d⇩d n')"
proof(induct as)
case Nil
have "(V,[],[]) ∈ dependent_live_vars n'" by fact
thus ?case
by(fastforce elim:dependent_live_vars.cases simp:targetnodes_def sourcenodes_def)
next
case (Cons ax asx)
note IH = ‹⟦(V,asx,asx) ∈ dependent_live_vars n';
asx ≠ [] ⟶ n' = last (targetnodes asx)⟧
⟹ V ∈ Use n' ∧ (∀as' a as''. asx = as'@a#as'' ⟶
¬ sourcenode a -{V}a#as''→⇩d⇩d n')›
from ‹(V,ax#asx,ax#asx) ∈ dependent_live_vars n'›
have "(V,asx,asx) ∈ dependent_live_vars n'"
and "¬ sourcenode ax -{V}ax#asx→⇩d⇩d last(targetnodes (ax#asx))"
by(auto elim:dependent_live_vars.cases)
from ‹ax#asx ≠ [] ⟶ n' = last (targetnodes (ax#asx))›
have "n' = last (targetnodes (ax#asx))" by simp
show ?case
proof(cases "asx = []")
case True
with ‹(V,asx,asx) ∈ dependent_live_vars n'› have "V ∈ Use n'"
by(fastforce elim:dependent_live_vars.cases)
from ‹¬ sourcenode ax -{V}ax#asx→⇩d⇩d last(targetnodes (ax#asx))›
True ‹n' = last (targetnodes (ax#asx))›
have "∀as' a as''. ax#asx = as'@a#as'' ⟶ ¬ sourcenode a -{V}a#as''→⇩d⇩d n'"
by auto(case_tac as',auto)
with ‹V ∈ Use n'› show ?thesis by simp
next
case False
with ‹n' = last (targetnodes (ax#asx))›
have "asx ≠ [] ⟶ n' = last (targetnodes asx)"
by(simp add:targetnodes_def)
from IH[OF ‹(V,asx,asx) ∈ dependent_live_vars n'› this]
have "V ∈ Use n' ∧ (∀as' a as''. asx = as'@a#as'' ⟶
¬ sourcenode a -{V}a#as''→⇩d⇩d n')" .
with ‹¬ sourcenode ax -{V}ax#asx→⇩d⇩d last(targetnodes (ax#asx))›
‹n' = last (targetnodes (ax#asx))› have "V ∈ Use n'"
and "∀as' a as''. ax#asx = as'@a#as'' ⟶
¬ sourcenode a -{V}a#as''→⇩d⇩d n'"
by auto(case_tac as',auto)
thus ?thesis by simp
qed
qed
lemma dependent_live_vars_same_paths:
"as ≠ [] ⟶ n' = last(targetnodes as) ⟹
(V,as,as) ∈ dependent_live_vars n' =
(V ∈ Use n' ∧ (∀as' a as''. as = as'@a#as'' ⟶
¬ sourcenode a -{V}a#as''→⇩d⇩d n'))"
by(fastforce intro!:dependent_live_vars_same_pathsD dependent_live_vars_same_pathsI)
lemma dependent_live_vars_cdep_empty_fst:
assumes "n'' -as→⇩c⇩d n'" and "V' ∈ Use n''"
shows "(V',[],as) ∈ dependent_live_vars n'"
proof(cases as)
case Nil
with ‹n'' -as→⇩c⇩d n'› show ?thesis
by(fastforce elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
next
case (Cons ax asx)
with ‹n'' -as→⇩c⇩d n'› have "sourcenode ax = n''"
by(auto dest:DynPDG_cdep_edge_CFG_path elim:path.cases)
from ‹n'' -as→⇩c⇩d n'› have "valid_node n'"
by(fastforce intro:path_valid_node(2) DynPDG_cdep_edge_CFG_path(1))
from Cons ‹n'' -as→⇩c⇩d n'› have "last(targetnodes as) = n'"
by(fastforce intro:path_targetnode dest:DynPDG_cdep_edge_CFG_path)
with Cons ‹n'' -as→⇩c⇩d n'› ‹V' ∈ Use n''› ‹sourcenode ax = n''› ‹valid_node n'›
have "(V', [], ax#asx@[]) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_cdep DynPDG_path_Nil)
with Cons show ?thesis by simp
qed
lemma dependent_live_vars_ddep_empty_fst:
assumes "n'' -{V}as→⇩d⇩d n'" and "V' ∈ Use n''"
shows "(V',[],as) ∈ dependent_live_vars n'"
proof(cases as)
case Nil
with ‹n'' -{V}as→⇩d⇩d n'› show ?thesis
by(fastforce elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
next
case (Cons ax asx)
with ‹n'' -{V}as→⇩d⇩d n'› have "sourcenode ax = n''"
by(auto dest:DynPDG_ddep_edge_CFG_path elim:path.cases)
from Cons ‹n'' -{V}as→⇩d⇩d n'› have "last(targetnodes as) = n'"
by(fastforce intro:path_targetnode elim:DynPDG_ddep_edge_CFG_path(1))
from Cons ‹n'' -{V}as→⇩d⇩d n'› have all:"∀as' a as''. asx = as'@a#as'' ⟶
¬ sourcenode a -{V}a#as''→⇩d⇩d n'"
by(fastforce dest:DynPDG_ddep_edge_no_shorter_ddep_edge)
from ‹n'' -{V}as→⇩d⇩d n'› have "V ∈ Use n'"
by(auto elim!:DynPDG_edge.cases simp:dyn_data_dependence_def)
from Cons ‹n'' -{V}as→⇩d⇩d n'› have "as ≠ [] ⟶ n' = last(targetnodes as)"
by(fastforce dest:DynPDG_ddep_edge_CFG_path path_targetnode)
with Cons have "asx ≠ [] ⟶ n' = last(targetnodes asx)"
by(fastforce simp:targetnodes_def)
with all ‹V ∈ Use n'› have "(V,asx,asx) ∈ dependent_live_vars n'"
by -(rule dependent_live_vars_same_pathsI)
with ‹V' ∈ Use n''› ‹n'' -{V}as→⇩d⇩d n'› ‹last(targetnodes as) = n'›
Cons ‹sourcenode ax = n''› show ?thesis
by(fastforce intro:dep_vars_Cons_ddep)
qed
lemma ddep_dependent_live_vars_keep_notempty:
assumes "n -{V}a#as→⇩d⇩d n''" and "as' ≠ []"
and "(V,as'',as') ∈ dependent_live_vars n'"
shows "(V,as@as'',as@as') ∈ dependent_live_vars n'"
proof -
from ‹n -{V}a#as→⇩d⇩d n''› have "∀n'' ∈ set (sourcenodes as). V ∉ Def n''"
by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
with ‹(V,as'',as') ∈ dependent_live_vars n'› show ?thesis
proof(induct as)
case Nil thus ?case by simp
next
case (Cons ax asx)
note IH = ‹⟦(V,as'',as') ∈ dependent_live_vars n';
∀n''∈set (sourcenodes asx). V ∉ Def n''⟧
⟹ (V, asx@as'',asx@as') ∈ dependent_live_vars n'›
from ‹∀n''∈set (sourcenodes (ax#asx)). V ∉ Def n''›
have "∀n''∈set (sourcenodes asx). V ∉ Def n''"
by(auto simp:sourcenodes_def)
from IH[OF ‹(V,as'',as') ∈ dependent_live_vars n'› this]
have "(V,asx@as'',asx@as') ∈ dependent_live_vars n'" .
from ‹as' ≠ []› ‹(V,as'',as') ∈ dependent_live_vars n'›
have "n' = last(targetnodes as')"
by(fastforce intro:dependent_live_vars_lastnode)
with ‹as' ≠ []› have "n' = last(targetnodes (ax#asx@as'))"
by(fastforce simp:targetnodes_def)
have "¬ sourcenode ax -{V}ax#asx@as''→⇩d⇩d last(targetnodes (ax#asx@as''))"
proof
assume "sourcenode ax -{V}ax#asx@as''→⇩d⇩d last(targetnodes (ax#asx@as''))"
hence "sourcenode ax -{V}ax#asx@as''→⇩d⇩d last(targetnodes (ax#asx@as''))"
by simp
with ‹∀n''∈set (sourcenodes (ax#asx)). V ∉ Def n''›
show False
by(fastforce elim:DynPDG_edge.cases
simp:dyn_data_dependence_def sourcenodes_def)
qed
with ‹(V,asx@as'',asx@as') ∈ dependent_live_vars n'›
‹n' = last(targetnodes (ax#asx@as'))›
show ?case by(fastforce intro:dep_vars_Cons_keep)
qed
qed
lemma dependent_live_vars_cdep_dependent_live_vars:
assumes "n'' -as''→⇩c⇩d n'" and "(V',as',as) ∈ dependent_live_vars n''"
shows "(V',as',as@as'') ∈ dependent_live_vars n'"
proof -
from ‹n'' -as''→⇩c⇩d n'› have "as'' ≠ []"
by(fastforce elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
with ‹n'' -as''→⇩c⇩d n'› have "last(targetnodes as'') = n'"
by(fastforce intro:path_targetnode elim:DynPDG_cdep_edge_CFG_path(1))
from ‹(V',as',as) ∈ dependent_live_vars n''› show ?thesis
proof(induct rule:dependent_live_vars.induct)
case (dep_vars_Use V')
from ‹V' ∈ Use n''› ‹n'' -as''→⇩c⇩d n'› ‹last(targetnodes as'') = n'› show ?case
by(fastforce intro:dependent_live_vars_cdep_empty_fst simp:targetnodes_def)
next
case (dep_vars_Cons_cdep V a as' nx asx)
from ‹n'' -as''→⇩c⇩d n'› have "n'' -as''→⇩d* n'" by(rule DynPDG_path_cdep)
with ‹nx -asx→⇩d* n''› have "nx -asx@as''→⇩d* n'"
by -(rule DynPDG_path_Append)
with ‹V ∈ Use (sourcenode a)› ‹(sourcenode a) -a#as'→⇩c⇩d nx›
show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_cdep)
next
case (dep_vars_Cons_ddep V as' as V' a)
from ‹as'' ≠ []› ‹last(targetnodes as'') = n'›
have "n' = last(targetnodes ((a#as)@as''))"
by(simp add:targetnodes_def)
with dep_vars_Cons_ddep
show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_ddep)
next
case (dep_vars_Cons_keep V as' as a)
from ‹as'' ≠ []› ‹last(targetnodes as'') = n'›
have "n' = last(targetnodes ((a#as)@as''))"
by(simp add:targetnodes_def)
with dep_vars_Cons_keep
show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_keep)
qed
qed
lemma dependent_live_vars_ddep_dependent_live_vars:
assumes "n'' -{V}as''→⇩d⇩d n'" and "(V',as',as) ∈ dependent_live_vars n''"
shows "(V',as',as@as'') ∈ dependent_live_vars n'"
proof -
from ‹n'' -{V}as''→⇩d⇩d n'› have "as'' ≠ []"
by(rule DynPDG_ddep_edge_CFG_path(2))
with ‹n'' -{V}as''→⇩d⇩d n'› have "last(targetnodes as'') = n'"
by(fastforce intro:path_targetnode elim:DynPDG_ddep_edge_CFG_path(1))
from ‹n'' -{V}as''→⇩d⇩d n'› have notExit:"n' ≠ (_Exit_)"
by(fastforce elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
from ‹(V',as',as) ∈ dependent_live_vars n''› show ?thesis
proof(induct rule:dependent_live_vars.induct)
case (dep_vars_Use V')
from ‹V' ∈ Use n''› ‹n'' -{V}as''→⇩d⇩d n'› ‹last(targetnodes as'') = n'› show ?case
by(fastforce intro:dependent_live_vars_ddep_empty_fst simp:targetnodes_def)
next
case (dep_vars_Cons_cdep V' a as' nx asx)
from ‹n'' -{V}as''→⇩d⇩d n'› have "n'' -as''→⇩d* n'" by(rule DynPDG_path_ddep)
with ‹nx -asx→⇩d* n''› have "nx -asx@as''→⇩d* n'"
by -(rule DynPDG_path_Append)
with ‹V' ∈ Use (sourcenode a)› ‹sourcenode a -a#as'→⇩c⇩d nx› notExit
show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_cdep)
next
case (dep_vars_Cons_ddep V as' as V' a)
from ‹as'' ≠ []› ‹last(targetnodes as'') = n'›
have "n' = last(targetnodes ((a#as)@as''))"
by(simp add:targetnodes_def)
with dep_vars_Cons_ddep
show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_ddep)
next
case (dep_vars_Cons_keep V as' as a)
from ‹as'' ≠ []› ‹last(targetnodes as'') = n'›
have "n' = last(targetnodes ((a#as)@as''))"
by(simp add:targetnodes_def)
with dep_vars_Cons_keep
show ?case by(fastforce intro:dependent_live_vars.dep_vars_Cons_keep)
qed
qed
lemma dependent_live_vars_dep_dependent_live_vars:
"⟦n'' -as''→⇩d* n'; (V',as',as) ∈ dependent_live_vars n''⟧
⟹ (V',as',as@as'') ∈ dependent_live_vars n'"
proof(induct rule:DynPDG_path.induct)
case (DynPDG_path_Nil n) thus ?case by simp
next
case (DynPDG_path_Append_cdep n asx n'' asx' n')
note IH = ‹(V', as', as) ∈ dependent_live_vars n ⟹
(V', as', as @ asx) ∈ dependent_live_vars n''›
from IH[OF ‹(V',as',as) ∈ dependent_live_vars n›]
have "(V',as',as@asx) ∈ dependent_live_vars n''" .
with ‹n'' -asx'→⇩c⇩d n'› have "(V',as',(as@asx)@asx') ∈ dependent_live_vars n'"
by(rule dependent_live_vars_cdep_dependent_live_vars)
thus ?case by simp
next
case (DynPDG_path_Append_ddep n asx n'' V asx' n')
note IH = ‹(V', as', as) ∈ dependent_live_vars n ⟹
(V', as', as @ asx) ∈ dependent_live_vars n''›
from IH[OF ‹(V',as',as) ∈ dependent_live_vars n›]
have "(V',as',as@asx) ∈ dependent_live_vars n''" .
with ‹n'' -{V}asx'→⇩d⇩d n'› have "(V',as',(as@asx)@asx') ∈ dependent_live_vars n'"
by(rule dependent_live_vars_ddep_dependent_live_vars)
thus ?case by simp
qed
end
end
Theory BitVector
section ‹Formalization of Bit Vectors›
theory BitVector imports Main begin
type_synonym bit_vector = "bool list"
fun bv_leqs :: "bit_vector ⇒ bit_vector ⇒ bool" ("_ ≼⇩b _" 99)
where bv_Nils:"[] ≼⇩b [] = True"
| bv_Cons:"(x#xs) ≼⇩b (y#ys) = ((x ⟶ y) ∧ xs ≼⇩b ys)"
| bv_rest:"xs ≼⇩b ys = False"
subsection ‹Some basic properties›
lemma bv_length: "xs ≼⇩b ys ⟹ length xs = length ys"
by(induct rule:bv_leqs.induct)auto
lemma [dest!]: "xs ≼⇩b [] ⟹ xs = []"
by(induct xs) auto
lemma bv_leqs_AppendI:
"⟦xs ≼⇩b ys; xs' ≼⇩b ys'⟧ ⟹ (xs@xs') ≼⇩b (ys@ys')"
by(induct xs ys rule:bv_leqs.induct,auto)
lemma bv_leqs_AppendD:
"⟦(xs@xs') ≼⇩b (ys@ys'); length xs = length ys⟧
⟹ xs ≼⇩b ys ∧ xs' ≼⇩b ys'"
by(induct xs ys rule:bv_leqs.induct,auto)
lemma bv_leqs_eq:
"xs ≼⇩b ys = ((∀i < length xs. xs ! i ⟶ ys ! i) ∧ length xs = length ys)"
proof(induct xs ys rule:bv_leqs.induct)
case (2 x xs y ys)
note eq = ‹xs ≼⇩b ys =
((∀i < length xs. xs ! i ⟶ ys ! i) ∧ length xs = length ys)›
show ?case
proof
assume leqs:"x#xs ≼⇩b y#ys"
with eq have "x ⟶ y" and "∀i < length xs. xs ! i ⟶ ys ! i"
and "length xs = length ys" by simp_all
from ‹x ⟶ y› have "(x#xs) ! 0 ⟶ (y#ys) ! 0" by simp
{ fix i assume "i > 0" and "i < length (x#xs)"
then obtain j where "i = Suc j" and "j < length xs" by(cases i) auto
with ‹∀i < length xs. xs ! i ⟶ ys ! i›
have "(x#xs) ! i ⟶ (y#ys) ! i" by auto }
hence "∀i < length (x#xs). i > 0 ⟶ (x#xs) ! i ⟶ (y#ys) ! i" by simp
with ‹(x#xs) ! 0 ⟶ (y#ys) ! 0› ‹length xs = length ys›
show "(∀i < length (x#xs). (x#xs) ! i ⟶ (y#ys) ! i) ∧
length (x#xs) = length (y#ys)"
by clarsimp(case_tac "i>0",auto)
next
assume "(∀i < length (x#xs). (x#xs) ! i ⟶ (y#ys) ! i) ∧
length (x#xs) = length (y#ys)"
hence "∀i < length (x#xs). (x#xs) ! i ⟶ (y#ys) ! i"
and "length (x#xs) = length (y#ys)" by simp_all
from ‹∀i < length (x#xs). (x#xs) ! i ⟶ (y#ys) ! i›
have "∀i < length xs. xs ! i ⟶ ys ! i"
by clarsimp(erule_tac x="Suc i" in allE,auto)
with eq ‹length (x#xs) = length (y#ys)› have "xs ≼⇩b ys" by simp
from ‹∀i < length (x#xs). (x#xs) ! i ⟶ (y#ys) ! i›
have "x ⟶ y" by(erule_tac x="0" in allE) simp
with ‹xs ≼⇩b ys› show "x#xs ≼⇩b y#ys" by simp
qed
qed simp_all
subsection ‹$\preceq_b$ is an order on bit vectors with minimal and
maximal element›
lemma minimal_element:
"replicate (length xs) False ≼⇩b xs"
by(induct xs) auto
lemma maximal_element:
"xs ≼⇩b replicate (length xs) True"
by(induct xs) auto
lemma bv_leqs_refl:"xs ≼⇩b xs"
by(induct xs) auto
lemma bv_leqs_trans:"⟦xs ≼⇩b ys; ys ≼⇩b zs⟧ ⟹ xs ≼⇩b zs"
proof(induct xs ys arbitrary:zs rule:bv_leqs.induct)
case (2 x xs y ys)
note IH = ‹⋀zs. ⟦xs ≼⇩b ys; ys ≼⇩b zs⟧ ⟹ xs ≼⇩b zs›
from ‹(x#xs) ≼⇩b (y#ys)› have "xs ≼⇩b ys" and "x ⟶ y" by simp_all
from ‹(y#ys) ≼⇩b zs› obtain z zs' where "zs = z#zs'" by(cases zs) auto
with ‹(y#ys) ≼⇩b zs› have "ys ≼⇩b zs'" and "y ⟶ z" by simp_all
from IH[OF ‹xs ≼⇩b ys› ‹ys ≼⇩b zs'›] have "xs ≼⇩b zs'" .
with ‹x ⟶ y› ‹y ⟶ z› ‹zs = z#zs'› show ?case by simp
qed simp_all
lemma bv_leqs_antisym:"⟦xs ≼⇩b ys; ys ≼⇩b xs⟧ ⟹ xs = ys"
by(induct xs ys rule:bv_leqs.induct)auto
definition bv_less :: "bit_vector ⇒ bit_vector ⇒ bool" ("_ ≺⇩b _" 99)
where "xs ≺⇩b ys ≡ xs ≼⇩b ys ∧ xs ≠ ys"
interpretation order "bv_leqs" "bv_less"
by(unfold_locales,
auto intro:bv_leqs_refl bv_leqs_trans bv_leqs_antisym simp:bv_less_def)
end
Theory DynSlice
section ‹Dynamic Backward Slice›
theory DynSlice imports DependentLiveVariables BitVector "../Basic/SemanticsCFG" begin
subsection ‹Backward slice of paths›
context DynPDG begin
fun slice_path :: "'edge list ⇒ bit_vector"
where "slice_path [] = []"
| "slice_path (a#as) = (let n' = last(targetnodes (a#as)) in
(sourcenode a -a#as→⇩d* n')#slice_path as)"
declare Let_def [simp]
lemma slice_path_length:
"length(slice_path as) = length as"
by(induct as) auto
lemma slice_path_right_Cons:
assumes slice:"slice_path as = x#xs"
obtains a' as' where "as = a'#as'" and "slice_path as' = xs"
proof(atomize_elim)
from slice show "∃a' as'. as = a'#as' ∧ slice_path as' = xs"
by(induct as) auto
qed
subsection ‹The proof of the fundamental property of (dynamic) slicing›
fun select_edge_kinds :: "'edge list ⇒ bit_vector ⇒ 'state edge_kind list"
where "select_edge_kinds [] [] = []"
| "select_edge_kinds (a#as) (b#bs) = (if b then kind a
else (case kind a of ⇑f ⇒ ⇑id | (Q)⇩√ ⇒ (λs. True)⇩√))#select_edge_kinds as bs"
definition slice_kinds :: "'edge list ⇒ 'state edge_kind list"
where "slice_kinds as = select_edge_kinds as (slice_path as)"
lemma select_edge_kinds_max_bv:
"select_edge_kinds as (replicate (length as) True) = kinds as"
by(induct as,auto simp:kinds_def)
lemma slice_path_leqs_information_same_Uses:
"⟦n -as→* n'; bs ≼⇩b bs'; slice_path as = bs;
select_edge_kinds as bs = es; select_edge_kinds as bs' = es';
∀V xs. (V,xs,as) ∈ dependent_live_vars n' ⟶ state_val s V = state_val s' V;
preds es' s'⟧
⟹ (∀V ∈ Use n'. state_val (transfers es s) V =
state_val (transfers es' s') V) ∧ preds es s"
proof(induct bs bs' arbitrary:as es es' n s s' rule:bv_leqs.induct)
case 1
from ‹slice_path as = []› have "as = []" by(cases as) auto
with ‹select_edge_kinds as [] = es› ‹select_edge_kinds as [] = es'›
have "es = []" and "es' = []" by simp_all
{ fix V assume "V ∈ Use n'"
hence "(V,[],[]) ∈ dependent_live_vars n'" by(rule dep_vars_Use)
with ‹∀V xs. (V,xs,as) ∈ dependent_live_vars n' ⟶
state_val s V = state_val s' V› ‹V ∈ Use n'› ‹as = []›
have "state_val s V = state_val s' V" by blast }
with ‹es = []› ‹es' = []› show ?case by simp
next
case (2 x xs y ys)
note all = ‹∀V xs. (V,xs,as) ∈ dependent_live_vars n' ⟶
state_val s V = state_val s' V›
note IH = ‹⋀as es es' n s s'. ⟦n -as→* n'; xs ≼⇩b ys; slice_path as = xs;
select_edge_kinds as xs = es; select_edge_kinds as ys = es';
∀V xs. (V,xs,as) ∈ dependent_live_vars n' ⟶
state_val s V = state_val s' V;
preds es' s'⟧
⟹ (∀V ∈ Use n'. state_val (transfers es s) V =
state_val (transfers es' s') V) ∧ preds es s›
from ‹x#xs ≼⇩b y#ys› have "x ⟶ y" and "xs ≼⇩b ys" by simp_all
from ‹slice_path as = x#xs› obtain a' as' where "as = a'#as'"
and "slice_path as' = xs" by(erule slice_path_right_Cons)
from ‹as = a'#as'› ‹select_edge_kinds as (x#xs) = es›
obtain ex esx where "es = ex#esx"
and ex:"ex = (if x then kind a'
else (case kind a' of ⇑f ⇒ ⇑id | (Q)⇩√ ⇒ (λs. True)⇩√))"
and "select_edge_kinds as' xs = esx" by auto
from ‹as = a'#as'› ‹select_edge_kinds as (y#ys) = es'› obtain ex' esx'
where "es' = ex'#esx'"
and ex':"ex' = (if y then kind a'
else (case kind a' of ⇑f ⇒ ⇑id | (Q)⇩√ ⇒ (λs. True)⇩√))"
and "select_edge_kinds as' ys = esx'" by auto
from ‹n -as→* n'› ‹as = a'#as'› have [simp]:"n = sourcenode a'"
and "valid_edge a'" and "targetnode a' -as'→* n'"
by(auto elim:path_split_Cons)
from ‹n -as→* n'› ‹as = a'#as'› have "last(targetnodes as) = n'"
by(fastforce intro:path_targetnode)
from ‹preds es' s'› ‹es' = ex'#esx'› have "pred ex' s'"
and "preds esx' (transfer ex' s')" by simp_all
show ?case
proof(cases "as' = []")
case True
hence [simp]:"as' = []" by simp
with ‹slice_path as' = xs› ‹xs ≼⇩b ys›
have [simp]:"xs = [] ∧ ys = []" by auto(cases ys,auto)+
with ‹select_edge_kinds as' xs = esx› ‹select_edge_kinds as' ys = esx'›
have [simp]:"esx = []" and [simp]:"esx' = []" by simp_all
from True ‹targetnode a' -as'→* n'›
have [simp]:"n' = targetnode a'" by(auto elim:path.cases)
show ?thesis
proof(cases x)
case True
with ‹x ⟶ y› ex ex' have [simp]:"ex = kind a' ∧ ex' = kind a'" by simp
have "pred ex s"
proof(cases ex)
case (Predicate Q)
with ex ex' True ‹x ⟶ y› have [simp]:"transfer ex s = s"
and [simp]:"transfer ex' s' = s'"
by(cases "kind a'",auto)+
show ?thesis
proof(cases "n -[a']→⇩c⇩d n'")
case True
{ fix V' assume "V' ∈ Use n"
with True ‹valid_edge a'›
have "(V',[],a'#[]@[]) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_cdep DynPDG_path_Nil
simp:targetnodes_def)
with all ‹as = a'#as'› have "state_val s V' = state_val s' V'"
by fastforce }
with ‹pred ex' s'› ‹valid_edge a'›
show ?thesis by(fastforce elim:CFG_edge_Uses_pred_equal)
next
case False
from ex True Predicate have "kind a' = (Q)⇩√" by(auto split:if_split_asm)
from True ‹slice_path as = x#xs› ‹as = a'#as'› have "n -[a']→⇩d* n'"
by(auto simp:targetnodes_def)
thus ?thesis
proof(induct rule:DynPDG_path.cases)
case (DynPDG_path_Nil nx)
hence False by simp
thus ?case by simp
next
case (DynPDG_path_Append_cdep nx asx n'' asx' nx')
from ‹[a'] = asx@asx'›
have "(asx = [a'] ∧ asx' = []) ∨ (asx = [] ∧ asx' = [a'])"
by (cases asx) auto
hence False
proof
assume "asx = [a'] ∧ asx' = []"
with ‹n'' -asx'→⇩c⇩d nx'› show False
by(fastforce elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
next
assume "asx = [] ∧ asx' = [a']"
with ‹nx -asx→⇩d* n''› have "nx = n''" and "asx' = [a']"
by(auto intro:DynPDG_empty_path_eq_nodes)
with ‹n = nx› ‹n' = nx'› ‹n'' -asx'→⇩c⇩d nx'› False
show False by simp
qed
thus ?thesis by simp
next
case (DynPDG_path_Append_ddep nx asx n'' V asx' nx')
from ‹[a'] = asx@asx'›
have "(asx = [a'] ∧ asx' = []) ∨ (asx = [] ∧ asx' = [a'])"
by (cases asx) auto
thus ?case
proof
assume "asx = [a'] ∧ asx' = []"
with ‹n'' -{V}asx'→⇩d⇩d nx'› have False
by(fastforce elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
thus ?thesis by simp
next
assume "asx = [] ∧ asx' = [a']"
with ‹nx -asx→⇩d* n''› have "nx = n''"
by(simp add:DynPDG_empty_path_eq_nodes)
{ fix V' assume "V' ∈ Use n"
from ‹n'' -{V}asx'→⇩d⇩d nx'› ‹asx = [] ∧ asx' = [a']› ‹n' = nx'›
have "(V,[],[]) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Use elim:DynPDG_edge.cases
simp:dyn_data_dependence_def)
with ‹V' ∈ Use n› ‹n'' -{V}asx'→⇩d⇩d nx'› ‹asx = [] ∧ asx' = [a']›
‹n = nx› ‹nx = n''› ‹n' = nx'›
have "(V',[],[a']) ∈ dependent_live_vars n'"
by(auto elim:dep_vars_Cons_ddep simp:targetnodes_def)
with all ‹as = a'#as'› have "state_val s V' = state_val s' V'"
by fastforce }
with ‹pred ex' s'› ‹valid_edge a'› ex ex' True ‹x ⟶ y› show ?thesis
by(fastforce elim:CFG_edge_Uses_pred_equal)
qed
qed
qed
qed simp
{ fix V assume "V ∈ Use n'"
from ‹V ∈ Use n'› have "(V,[],[]) ∈ dependent_live_vars n'"
by(rule dep_vars_Use)
have "state_val (transfer ex s) V = state_val (transfer ex' s') V"
proof(cases "n -{V}[a']→⇩d⇩d n'")
case True
hence "V ∈ Def n"
by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
have "⋀V. V ∈ Use n ⟹ state_val s V = state_val s' V"
proof -
fix V' assume "V' ∈ Use n"
with ‹(V,[],[]) ∈ dependent_live_vars n'› True
have "(V',[],[a']) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_ddep simp:targetnodes_def)
with all ‹as = a'#as'› show "state_val s V' = state_val s' V'" by auto
qed
with ‹valid_edge a'› ‹pred ex' s'› ‹pred ex s›
have "∀V ∈ Def n. state_val (transfer (kind a') s) V =
state_val (transfer (kind a') s') V"
by simp(rule CFG_edge_transfer_uses_only_Use,auto)
with ‹V ∈ Def n› have "state_val (transfer (kind a') s) V =
state_val (transfer (kind a') s') V"
by simp
thus ?thesis by fastforce
next
case False
with ‹last(targetnodes as) = n'› ‹as = a'#as'›
‹(V,[],[]) ∈ dependent_live_vars n'›
have "(V,[a'],[a']) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_keep)
from ‹(V,[a'],[a']) ∈ dependent_live_vars n'› all ‹as = a'#as'›
have states_eq:"state_val s V = state_val s' V"
by auto
from ‹valid_edge a'› ‹V ∈ Use n'› False ‹pred ex s›
have "state_val (transfers (kinds [a']) s) V = state_val s V"
apply(auto intro!:no_ddep_same_state path_edge simp:targetnodes_def)
apply(simp add:kinds_def)
by(case_tac as',auto)
moreover
from ‹valid_edge a'› ‹V ∈ Use n'› False ‹pred ex' s'›
have "state_val (transfers (kinds [a']) s') V = state_val s' V"
apply(auto intro!:no_ddep_same_state path_edge simp:targetnodes_def)
apply(simp add:kinds_def)
by(case_tac as',auto)
ultimately show ?thesis using states_eq by(auto simp:kinds_def)
qed }
hence "∀V ∈ Use n'. state_val (transfer ex s) V =
state_val (transfer ex' s') V" by simp
with ‹pred ex s› ‹es = ex#esx› ‹es' = ex'#esx'› show ?thesis by simp
next
case False
with ex have cases_x:"ex = (case kind a' of ⇑f ⇒ ⇑id | (Q)⇩√ ⇒ (λs. True)⇩√)"
by simp
from cases_x have "pred ex s" by(cases "kind a'",auto)
show ?thesis
proof(cases y)
case True
with ex' have [simp]:"ex' = kind a'" by simp
{ fix V assume "V ∈ Use n'"
from ‹V ∈ Use n'› have "(V,[],[]) ∈ dependent_live_vars n'"
by(rule dep_vars_Use)
from ‹slice_path as = x#xs› ‹as = a'#as'› ‹¬ x›
have "¬ n -[a']→⇩d* n'" by(simp add:targetnodes_def)
hence "¬ n -{V}[a']→⇩d⇩d n'" by(fastforce dest:DynPDG_path_ddep)
with ‹last(targetnodes as) = n'› ‹as = a'#as'›
‹(V,[],[]) ∈ dependent_live_vars n'›
have "(V,[a'],[a']) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_keep)
with all ‹as = a'#as'› have "state_val s V = state_val s' V" by auto
from ‹valid_edge a'› ‹V ∈ Use n'› ‹pred ex' s'›
‹¬ n -{V}[a']→⇩d⇩d n'› ‹last(targetnodes as) = n'› ‹as = a'#as'›
have "state_val (transfers (kinds [a']) s') V = state_val s' V"
apply(auto intro!:no_ddep_same_state path_edge)
apply(simp add:kinds_def)
by(case_tac as',auto)
with ‹state_val s V = state_val s' V› cases_x
have "state_val (transfer ex s) V =
state_val (transfer ex' s') V"
by(cases "kind a'",simp_all add:kinds_def) }
hence "∀V ∈ Use n'. state_val (transfer ex s) V =
state_val (transfer ex' s') V" by simp
with ‹as = a'#as'› ‹es = ex#esx› ‹es' = ex'#esx'› ‹pred ex s›
show ?thesis by simp
next
case False
with ex' have cases_y:"ex' = (case kind a' of ⇑f ⇒ ⇑id | (Q)⇩√ ⇒ (λs. True)⇩√)"
by simp
with cases_x have [simp]:"ex = ex'" by(cases "kind a'") auto
{ fix V assume "V ∈ Use n'"
from ‹V ∈ Use n'› have "(V,[],[]) ∈ dependent_live_vars n'"
by(rule dep_vars_Use)
from ‹slice_path as = x#xs› ‹as = a'#as'› ‹¬ x›
have "¬ n -[a']→⇩d* n'" by(simp add:targetnodes_def)
hence no_dep:"¬ n -{V}[a']→⇩d⇩d n'" by(fastforce dest:DynPDG_path_ddep)
with ‹last(targetnodes as) = n'› ‹as = a'#as'›
‹(V,[],[]) ∈ dependent_live_vars n'›
have "(V,[a'],[a']) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_keep)
with all ‹as = a'#as'› have "state_val s V = state_val s' V" by auto }
with ‹as = a'#as'› cases_x ‹es = ex#esx› ‹es' = ex'#esx'› ‹pred ex s›
show ?thesis by(cases "kind a'",auto)
qed
qed
next
case False
show ?thesis
proof(cases "∀V xs. (V,xs,as') ∈ dependent_live_vars n' ⟶
state_val (transfer ex s) V = state_val (transfer ex' s') V")
case True
hence imp':"∀V xs. (V,xs,as') ∈ dependent_live_vars n' ⟶
state_val (transfer ex s) V = state_val (transfer ex' s') V" .
from IH[OF ‹targetnode a' -as'→* n'› ‹xs ≼⇩b ys› ‹slice_path as' = xs›
‹select_edge_kinds as' xs = esx› ‹select_edge_kinds as' ys = esx'›
this ‹preds esx' (transfer ex' s')›]
have all':"∀V∈Use n'. state_val (transfers esx (transfer ex s)) V =
state_val (transfers esx' (transfer ex' s')) V"
and "preds esx (transfer ex s)" by simp_all
have "pred ex s"
proof(cases ex)
case (Predicate Q)
with ‹slice_path as = x#xs› ‹as = a'#as'› ‹last(targetnodes as) = n'› ex
have "ex = (λs. True)⇩√ ∨ n -a'#as'→⇩d* n'"
by(cases "kind a'",auto split:if_split_asm)
thus ?thesis
proof
assume "ex = (λs. True)⇩√" thus ?thesis by simp
next
assume "n -a'#as'→⇩d* n'"
with ‹slice_path as = x#xs› ‹as = a'#as'› ‹last(targetnodes as) = n'› ex
have [simp]:"ex = kind a'" by clarsimp
with ‹x ⟶ y› ex ex' have [simp]:"ex' = ex" by(cases x) auto
from ‹n -a'#as'→⇩d* n'› show ?thesis
proof(induct rule:DynPDG_path_rev_cases)
case DynPDG_path_Nil
hence False by simp
thus ?thesis by simp
next
case (DynPDG_path_cdep_Append n'' asx asx')
from ‹n -asx→⇩c⇩d n''›have "asx ≠ []"
by(auto elim:DynPDG_edge.cases dest:dyn_control_dependence_path)
with ‹n -asx→⇩c⇩d n''› ‹n'' -asx'→⇩d* n'› ‹a'#as' = asx@asx'›
have cdep:"∃as1 as2 n''. n -a'#as1→⇩c⇩d n'' ∧
n'' -as2→⇩d* n' ∧ as' = as1@as2"
by(cases asx) auto
{ fix V assume "V ∈ Use n"
with cdep ‹last(targetnodes as) = n'› ‹as = a'#as'›
have "(V,[],as) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_cdep)
with all have "state_val s V = state_val s' V" by blast }
with ‹valid_edge a'› ‹pred ex' s'›
show ?thesis by(fastforce elim:CFG_edge_Uses_pred_equal)
next
case (DynPDG_path_ddep_Append V n'' asx asx')
from ‹n -{V}asx→⇩d⇩d n''› obtain ai ais where "asx = ai#ais"
by(cases asx)(auto dest:DynPDG_ddep_edge_CFG_path)
with ‹n -{V}asx→⇩d⇩d n''› have "sourcenode ai = n"
by(fastforce dest:DynPDG_ddep_edge_CFG_path elim:path.cases)
from ‹n -{V}asx→⇩d⇩d n''› ‹asx = ai#ais›
have "last(targetnodes asx) = n''"
by(fastforce intro:path_targetnode dest:DynPDG_ddep_edge_CFG_path)
{ fix V' assume "V' ∈ Use n"
from ‹n -{V}asx→⇩d⇩d n''› have "(V,[],[]) ∈ dependent_live_vars n''"
by(fastforce elim:DynPDG_edge.cases dep_vars_Use
simp:dyn_data_dependence_def)
with ‹n'' -asx'→⇩d* n'› have "(V,[],[]@asx') ∈ dependent_live_vars n'"
by(rule dependent_live_vars_dep_dependent_live_vars)
have "(V',[],as) ∈ dependent_live_vars n'"
proof(cases "asx' = []")
case True
with ‹n'' -asx'→⇩d* n'› have "n'' = n'"
by(fastforce intro:DynPDG_empty_path_eq_nodes)
with ‹n -{V}asx→⇩d⇩d n''› ‹V' ∈ Use n› True ‹as = a'#as'›
‹a'#as' = asx@asx'›
show ?thesis by(fastforce intro:dependent_live_vars_ddep_empty_fst)
next
case False
with ‹n -{V}asx→⇩d⇩d n''› ‹asx = ai#ais›
‹(V,[],[]@asx') ∈ dependent_live_vars n'›
have "(V,ais@[],ais@asx') ∈ dependent_live_vars n'"
by(fastforce intro:ddep_dependent_live_vars_keep_notempty)
from ‹n'' -asx'→⇩d* n'› False have "last(targetnodes asx') = n'"
by -(rule path_targetnode,rule DynPDG_path_CFG_path)
with ‹(V,ais@[],ais@asx') ∈ dependent_live_vars n'›
‹V' ∈ Use n› ‹n -{V}asx→⇩d⇩d n''› ‹asx = ai#ais›
‹sourcenode ai = n› ‹last(targetnodes asx) = n''› False
have "(V',[],ai#ais@asx') ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_ddep simp:targetnodes_def)
with ‹asx = ai#ais› ‹a'#as' = asx@asx'› ‹as = a'#as'›
show ?thesis by simp
qed
with all have "state_val s V' = state_val s' V'" by blast }
with ‹pred ex' s'› ‹valid_edge a'›
show ?thesis by(fastforce elim:CFG_edge_Uses_pred_equal)
qed
qed
qed simp
with all' ‹preds esx (transfer ex s)› ‹es = ex#esx› ‹es' = ex'#esx'›
show ?thesis by simp
next
case False
then obtain V' xs' where "(V',xs',as') ∈ dependent_live_vars n'"
and "state_val (transfer ex s) V' ≠ state_val (transfer ex' s') V'"
by auto
show ?thesis
proof(cases "n -a'#as'→⇩d* n'")
case True
with ‹slice_path as = x#xs› ‹as = a'#as'› ‹last(targetnodes as) = n'› ex
have [simp]:"ex = kind a'" by clarsimp
with ‹x ⟶ y› ex ex' have [simp]:"ex' = ex" by(cases x) auto
{ fix V assume "V ∈ Use (sourcenode a')"
hence "(V,[],[]) ∈ dependent_live_vars (sourcenode a')"
by(rule dep_vars_Use)
with ‹n -a'#as'→⇩d* n'› have "(V,[],[]@a'#as') ∈ dependent_live_vars n'"
by(fastforce intro:dependent_live_vars_dep_dependent_live_vars)
with all ‹as = a'#as'› have "state_val s V = state_val s' V"
by fastforce }
with ‹pred ex' s'› ‹valid_edge a'› have "pred ex s"
by(fastforce intro:CFG_edge_Uses_pred_equal)
show ?thesis
proof(cases "V' ∈ Def n")
case True
with ‹state_val (transfer ex s) V' ≠ state_val (transfer ex' s') V'›
‹valid_edge a'› ‹pred ex' s'› ‹pred ex s›
CFG_edge_transfer_uses_only_Use[of a' s s']
obtain V'' where "V'' ∈ Use n"
and "state_val s V'' ≠ state_val s' V''"
by auto
from True ‹(V',xs',as') ∈ dependent_live_vars n'›
‹targetnode a' -as'→* n'› ‹last(targetnodes as) = n'› ‹as = a'#as'›
‹valid_edge a'› ‹n = sourcenode a'›[THEN sym]
have "n -{V'}a'#xs'→⇩d⇩d last(targetnodes (a'#xs'))"
by -(drule dependent_live_vars_dependent_edge,
auto dest!: dependent_live_vars_dependent_edge
dest:DynPDG_ddep_edge_CFG_path path_targetnode
simp del:‹n = sourcenode a'›)
with ‹(V',xs',as') ∈ dependent_live_vars n'› ‹V'' ∈ Use n›
‹last(targetnodes as) = n'› ‹as = a'#as'›
have "(V'',[],as) ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_ddep)
with all have "state_val s V'' = state_val s' V''" by blast
with ‹state_val s V'' ≠ state_val s' V''› have False by simp
thus ?thesis by simp
next
case False
with ‹valid_edge a'› ‹pred ex s›
have "state_val (transfer (kind a') s) V' = state_val s V'"
by(fastforce intro:CFG_edge_no_Def_equal)
moreover
from False ‹valid_edge a'› ‹pred ex' s'›
have "state_val (transfer (kind a') s') V' = state_val s' V'"
by(fastforce intro:CFG_edge_no_Def_equal)
ultimately have "state_val s V' ≠ state_val s' V'"
using ‹state_val (transfer ex s) V' ≠ state_val (transfer ex' s') V'›
by simp
from False have "¬ n -{V'}a'#xs'→⇩d⇩d
last(targetnodes (a'#xs'))"
by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
with ‹(V',xs',as') ∈ dependent_live_vars n'› ‹last(targetnodes as) = n'›
‹as = a'#as'›
have "(V',a'#xs',a'#as') ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_keep)
with ‹as = a'#as'› all have "state_val s V' = state_val s' V'" by auto
with ‹state_val s V' ≠ state_val s' V'› have False by simp
thus ?thesis by simp
qed
next
case False
{ assume "V' ∈ Def n"
with ‹(V',xs',as') ∈ dependent_live_vars n'› ‹targetnode a' -as'→* n'›
‹valid_edge a'›
have "n -a'#as'→⇩d* n'"
by -(drule dependent_live_vars_dependent_edge,
auto dest:DynPDG_path_ddep DynPDG_path_Append)
with False have "False" by simp }
hence "V' ∉ Def (sourcenode a')" by fastforce
from False ‹slice_path as = x#xs› ‹as = a'#as'›
‹last(targetnodes as) = n'› ‹as' ≠ []›
have "¬ x" by(auto simp:targetnodes_def)
with ex have cases:"ex = (case kind a' of ⇑f ⇒ ⇑id | (Q)⇩√ ⇒ (λs. True)⇩√)"
by simp
have "state_val s V' ≠ state_val s' V'"
proof(cases y)
case True
with ex' have [simp]:"ex' = kind a'" by simp
from ‹V' ∉ Def (sourcenode a')› ‹valid_edge a'› ‹pred ex' s'›
have states_eq:"state_val (transfer (kind a') s') V' = state_val s' V'"
by(fastforce intro:CFG_edge_no_Def_equal)
from cases have "state_val s V' = state_val (transfer ex s) V'"
by(cases "kind a'") auto
with states_eq
‹state_val (transfer ex s) V' ≠ state_val (transfer ex' s') V'›
show ?thesis by simp
next
case False
with ex' have "ex' = (case kind a' of ⇑f ⇒ ⇑id | (Q)⇩√ ⇒ (λs. True)⇩√)"
by simp
with cases have "state_val s V' = state_val (transfer ex s) V'"
and "state_val s' V' = state_val (transfer ex' s') V'"
by(cases "kind a'",auto)+
with ‹state_val (transfer ex s) V' ≠ state_val (transfer ex' s') V'›
show ?thesis by simp
qed
from ‹V' ∉ Def (sourcenode a')›
have "¬ n -{V'}a'#xs'→⇩d⇩d last(targetnodes (a'#xs'))"
by(auto elim:DynPDG_edge.cases simp:dyn_data_dependence_def)
with ‹(V',xs',as') ∈ dependent_live_vars n'› ‹last(targetnodes as) = n'›
‹as = a'#as'›
have "(V',a'#xs',a'#as') ∈ dependent_live_vars n'"
by(fastforce intro:dep_vars_Cons_keep)
with ‹as = a'#as'› all have "state_val s V' = state_val s' V'" by auto
with ‹state_val s V' ≠ state_val s' V'› have False by simp
thus ?thesis by simp
qed
qed
qed
qed simp_all
theorem fundamental_property_of_path_slicing:
assumes "n -as→* n'" and "preds (kinds as) s"
shows "(∀V ∈ Use n'. state_val (transfers (slice_kinds as) s) V =
state_val (transfers (kinds as) s) V)"
and "preds (slice_kinds as) s"
proof -
have "length as = length (slice_path as)" by(simp add:slice_path_length)
hence "slice_path as ≼⇩b replicate (length as) True"
by(simp add:maximal_element)
have "select_edge_kinds as (replicate (length as) True) = kinds as"
by(rule select_edge_kinds_max_bv)
with ‹n -as→* n'› ‹slice_path as ≼⇩b replicate (length as) True›
‹preds (kinds as) s›
have "(∀V∈Use n'. state_val (transfers (slice_kinds as) s) V =
state_val (transfers (kinds as) s) V) ∧ preds (slice_kinds as) s"
by -(rule slice_path_leqs_information_same_Uses,simp_all add:slice_kinds_def)
thus "∀V∈Use n'. state_val (transfers (slice_kinds as) s) V =
state_val (transfers (kinds as) s) V" and "preds (slice_kinds as) s"
by simp_all
qed
end
subsection ‹The fundamental property of (dynamic) slicing related to the semantics›
locale BackwardPathSlice_wf =
DynPDG sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
dyn_control_dependence +
CFG_semantics_wf sourcenode targetnode kind valid_edge Entry sem identifies
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val"
and dyn_control_dependence :: "'node ⇒ 'node ⇒ 'edge list ⇒ bool"
("_ controls _ via _" [51, 0, 0] 1000)
and Exit :: "'node" ("'('_Exit'_')")
and sem :: "'com ⇒ 'state ⇒ 'com ⇒ 'state ⇒ bool"
("((1⟨_,/_⟩) ⇒/ (1⟨_,/_⟩))" [0,0,0,0] 81)
and identifies :: "'node ⇒ 'com ⇒ bool" ("_ ≜ _" [51, 0] 80)
begin
theorem fundamental_property_of_path_slicing_semantically:
assumes "n ≜ c" and "⟨c,s⟩ ⇒ ⟨c',s'⟩"
obtains n' as where "n -as→* n'" and "preds (slice_kinds as) s"
and "n' ≜ c'"
and "∀V ∈ Use n'. state_val (transfers (slice_kinds as) s) V =
state_val s' V"
proof(atomize_elim)
from ‹n ≜ c› ‹⟨c,s⟩ ⇒ ⟨c',s'⟩› obtain n' as where "n -as→* n'"
and "transfers (kinds as) s = s'"
and "preds (kinds as) s"
and "n' ≜ c'"
by(fastforce dest:fundamental_property)
with ‹n -as→* n'› ‹preds (kinds as) s›
have "∀V ∈ Use n'. state_val (transfers (slice_kinds as) s) V =
state_val (transfers (kinds as) s) V" and "preds (slice_kinds as) s"
by -(rule fundamental_property_of_path_slicing,simp_all)+
with ‹transfers (kinds as) s = s'› have "∀V ∈ Use n'.
state_val (transfers (slice_kinds as) s) V =
state_val s' V" by simp
with ‹n -as→* n'› ‹preds (slice_kinds as) s› ‹n' ≜ c'›
show "∃as n'. n -as→* n' ∧ preds (slice_kinds as) s ∧ n' ≜ c' ∧
(∀V∈Use n'. state_val (transfers (slice_kinds as) s) V = state_val s' V)"
by blast
qed
end
end
Theory Observable
section ‹Observable Sets of Nodes›
theory Observable imports "../Basic/CFG" begin
context CFG begin
inductive_set obs :: "'node ⇒ 'node set ⇒ 'node set"
for n::"'node" and S::"'node set"
where obs_elem:
"⟦n -as→* n'; ∀nx ∈ set(sourcenodes as). nx ∉ S; n' ∈ S⟧ ⟹ n' ∈ obs n S"
lemma obsE:
assumes "n' ∈ obs n S"
obtains as where "n -as→* n'" and "∀nx ∈ set(sourcenodes as). nx ∉ S"
and "n' ∈ S"
proof(atomize_elim)
from ‹n' ∈ obs n S›
have "∃as. n -as→* n' ∧ (∀nx ∈ set(sourcenodes as). nx ∉ S) ∧ n' ∈ S"
by(auto elim:obs.cases)
thus "∃as. n -as→* n' ∧ (∀nx∈set (sourcenodes as). nx ∉ S) ∧ n' ∈ S" by blast
qed
lemma n_in_obs:
assumes "valid_node n" and "n ∈ S" shows "obs n S = {n}"
proof -
from ‹valid_node n› have "n -[]→* n" by(rule empty_path)
with ‹n ∈ S› have "n ∈ obs n S" by(fastforce elim:obs_elem simp:sourcenodes_def)
{ fix n' assume "n' ∈ obs n S"
have "n' = n"
proof(rule ccontr)
assume "n' ≠ n"
from ‹n' ∈ obs n S› obtain as where "n -as→* n'"
and "∀nx ∈ set(sourcenodes as). nx ∉ S"
and "n' ∈ S" by(erule obsE)
from ‹n -as→* n'› ‹∀nx ∈ set(sourcenodes as). nx ∉ S› ‹n' ≠ n› ‹n ∈ S›
show False
proof(induct rule:path.induct)
case (Cons_path n'' as n' a n)
from ‹∀nx∈set (sourcenodes (a#as)). nx ∉ S› ‹sourcenode a = n›
have "n ∉ S" by(simp add:sourcenodes_def)
with ‹n ∈ S› show False by simp
qed simp
qed }
with ‹n ∈ obs n S› show ?thesis by fastforce
qed
lemma in_obs_valid:
assumes "n' ∈ obs n S" shows "valid_node n" and "valid_node n'"
using ‹n' ∈ obs n S›
by(auto elim:obsE intro:path_valid_node)
lemma edge_obs_subset:
assumes"valid_edge a" and "sourcenode a ∉ S"
shows "obs (targetnode a) S ⊆ obs (sourcenode a) S"
proof
fix n assume "n ∈ obs (targetnode a) S"
then obtain as where "targetnode a -as→* n"
and all:"∀nx ∈ set(sourcenodes as). nx ∉ S" and "n ∈ S" by(erule obsE)
from ‹valid_edge a› ‹targetnode a -as→* n›
have "sourcenode a -a#as→* n" by(fastforce intro:Cons_path)
moreover
from all ‹sourcenode a ∉ S› have "∀nx ∈ set(sourcenodes (a#as)). nx ∉ S"
by(simp add:sourcenodes_def)
ultimately show "n ∈ obs (sourcenode a) S" using ‹n ∈ S›
by(rule obs_elem)
qed
lemma path_obs_subset:
"⟦n -as→* n'; ∀n' ∈ set(sourcenodes as). n' ∉ S⟧
⟹ obs n' S ⊆ obs n S"
proof(induct rule:path.induct)
case (Cons_path n'' as n' a n)
note IH = ‹∀n'∈set (sourcenodes as). n' ∉ S ⟹ obs n' S ⊆ obs n'' S›
from ‹∀n'∈set (sourcenodes (a#as)). n' ∉ S›
have all:"∀n'∈set (sourcenodes as). n' ∉ S" and "sourcenode a ∉ S"
by(simp_all add:sourcenodes_def)
from IH[OF all] have "obs n' S ⊆ obs n'' S" .
from ‹valid_edge a› ‹targetnode a = n''› ‹sourcenode a = n› ‹sourcenode a ∉ S›
have "obs n'' S ⊆ obs n S" by(fastforce dest:edge_obs_subset)
with ‹obs n' S ⊆ obs n'' S› show ?case by fastforce
qed simp
lemma path_ex_obs:
assumes "n -as→* n'" and "n' ∈ S"
obtains m where "m ∈ obs n S"
proof(atomize_elim)
show "∃m. m ∈ obs n S"
proof(cases "∀nx ∈ set(sourcenodes as). nx ∉ S")
case True
with ‹n -as→* n'› ‹n' ∈ S› have "n' ∈ obs n S" by -(rule obs_elem)
thus ?thesis by fastforce
next
case False
hence "∃nx ∈ set(sourcenodes as). nx ∈ S" by fastforce
then obtain nx ns ns' where "sourcenodes as = ns@nx#ns'"
and "nx ∈ S" and "∀n' ∈ set ns. n' ∉ S"
by(fastforce elim!:split_list_first_propE)
from ‹sourcenodes as = ns@nx#ns'› obtain as' a as''
where "ns = sourcenodes as'"
and "as = as'@a#as''" and "sourcenode a = nx"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
with ‹n -as→* n'› have "n -as'→* nx" by(fastforce dest:path_split)
with ‹nx ∈ S› ‹∀n' ∈ set ns. n' ∉ S› ‹ns = sourcenodes as'› have "nx ∈ obs n S"
by(fastforce intro:obs_elem)
thus ?thesis by fastforce
qed
qed
end
end
Theory Distance
chapter ‹Static Intraprocedural Slicing›
theory Distance imports "../Basic/CFG" begin
text ‹
Static Slicing analyses a CFG prior to execution. Whereas dynamic
slicing can provide better results for certain inputs (i.e.\ trace and
initial state), static slicing is more conservative but provides
results independent of inputs.
Correctness for static slicing is
defined differently than correctness of dynamic slicing by a weak
simulation between nodes and states when traversing the original and
the sliced graph. The weak simulation property demands that if a
(node,state) tuples $(n_1,s_1)$ simulates $(n_2,s_2)$
and making an observable move in the original graph leads from
$(n_1,s_1)$ to $(n_1',s_1')$, this tuple simulates a
tuple $(n_2,s_2)$ which is the result of making an
observable move in the sliced graph beginning in $(n_2',s_2')$.
We also show how a ``dynamic slicing style'' correctness criterion for
static slicing of a given trace and initial state could look like.
This formalization of static intraprocedural slicing is instantiable
with three different kinds of control dependences: standard control,
weak control and weak order dependence. The correctness proof for
slicing is independent of the control dependence used, it bases only
on one property every control dependence definition hass to fulfill.
›
section ‹Distance of Paths›
context CFG begin
inductive distance :: "'node ⇒ 'node ⇒ nat ⇒ bool"
where distanceI:
"⟦n -as→* n'; length as = x; ∀as'. n -as'→* n' ⟶ x ≤ length as'⟧
⟹ distance n n' x"
lemma every_path_distance:
assumes "n -as→* n'"
obtains x where "distance n n' x" and "x ≤ length as"
proof -
have "∃x. distance n n' x ∧ x ≤ length as"
proof(cases "∃as'. n -as'→* n' ∧
(∀asx. n -asx→* n' ⟶ length as' ≤ length asx)")
case True
then obtain as'
where "n -as'→* n' ∧ (∀asx. n -asx→* n' ⟶ length as' ≤ length asx)"
by blast
hence "n -as'→* n'" and all:"∀asx. n -asx→* n' ⟶ length as' ≤ length asx"
by simp_all
hence "distance n n' (length as')" by(fastforce intro:distanceI)
from ‹n -as→* n'› all have "length as' ≤ length as" by fastforce
with ‹distance n n' (length as')› show ?thesis by blast
next
case False
hence all:"∀as'. n -as'→* n' ⟶ (∃asx. n -asx→* n' ∧ length as' > length asx)"
by fastforce
have "wf (measure length)" by simp
from ‹n -as→* n'› have "as ∈ {as. n -as→* n'}" by simp
with ‹wf (measure length)› obtain as' where "as' ∈ {as. n -as→* n'}"
and notin:"⋀as''. (as'',as') ∈ (measure length) ⟹ as'' ∉ {as. n -as→* n'}"
by(erule wfE_min)
from ‹as' ∈ {as. n -as→* n'}› have "n -as'→* n'" by simp
with all obtain asx where "n -asx→* n'"
and "length as' > length asx"
by blast
with notin have "asx ∉ {as. n -as→* n'}" by simp
hence "¬ n -asx→* n'" by simp
with ‹n -asx→* n'› have False by simp
thus ?thesis by simp
qed
with that show ?thesis by blast
qed
lemma distance_det:
"⟦distance n n' x; distance n n' x'⟧ ⟹ x = x'"
apply(erule distance.cases)+ apply clarsimp
apply(erule_tac x="asa" in allE) apply(erule_tac x="as" in allE)
by simp
lemma only_one_SOME_dist_edge:
assumes valid:"valid_edge a" and dist:"distance (targetnode a) n' x"
shows "∃!a'. sourcenode a = sourcenode a' ∧ distance (targetnode a') n' x ∧
valid_edge a' ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ targetnode a' = nx)"
proof(rule ex_ex1I)
show "∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧ valid_edge a' ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ targetnode a' = nx)"
proof -
have "(∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧ valid_edge a' ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ targetnode a' = nx)) =
(∃nx. ∃a'. sourcenode a = sourcenode a' ∧ distance (targetnode a') n' x ∧
valid_edge a' ∧ targetnode a' = nx)"
apply(unfold some_eq_ex[of "λnx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧valid_edge a' ∧ targetnode a' = nx"])
by simp
also have "…" using valid dist by blast
finally show ?thesis .
qed
next
fix a' ax
assume "sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧ valid_edge a' ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ targetnode a' = nx)"
and "sourcenode a = sourcenode ax ∧
distance (targetnode ax) n' x ∧ valid_edge ax ∧
targetnode ax = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ targetnode a' = nx)"
thus "a' = ax" by(fastforce intro!:edge_det)
qed
lemma distance_successor_distance:
assumes "distance n n' x" and "x ≠ 0"
obtains a where "valid_edge a" and "n = sourcenode a"
and "distance (targetnode a) n' (x - 1)"
and "targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ targetnode a' = nx)"
proof -
have "∃a. valid_edge a ∧ n = sourcenode a ∧ distance (targetnode a) n' (x - 1) ∧
targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ targetnode a' = nx)"
proof(rule ccontr)
assume "¬ (∃a. valid_edge a ∧ n = sourcenode a ∧
distance (targetnode a) n' (x - 1) ∧
targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ targetnode a' = nx))"
hence imp:"∀a. valid_edge a ∧ n = sourcenode a ∧
targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ targetnode a' = nx)
⟶ ¬ distance (targetnode a) n' (x - 1)" by blast
from ‹distance n n' x› obtain as where "n -as→* n'" and "x = length as"
and "∀as'. n -as'→* n' ⟶ x ≤ length as'"
by(auto elim:distance.cases)
thus False using imp
proof(induct rule:path.induct)
case (empty_path n)
from ‹x = length []› ‹x ≠ 0› show False by simp
next
case (Cons_path n'' as n' a n)
note imp = ‹∀a. valid_edge a ∧ n = sourcenode a ∧
targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' (x - 1) ∧
valid_edge a' ∧ targetnode a' = nx)
⟶ ¬ distance (targetnode a) n' (x - 1)›
note all = ‹∀as'. n -as'→* n' ⟶ x ≤ length as'›
from ‹n'' -as→* n'› obtain y where "distance n'' n' y"
and "y ≤ length as" by(erule every_path_distance)
from ‹distance n'' n' y› obtain as' where "n'' -as'→* n'"
and "y = length as'"
by(auto elim:distance.cases)
show False
proof(cases "y < length as")
case True
from ‹valid_edge a› ‹sourcenode a = n› ‹targetnode a = n''› ‹n'' -as'→* n'›
have "n -a#as'→* n'" by -(rule path.Cons_path)
with all have "x ≤ length (a#as')" by blast
with ‹x = length (a#as)› True ‹y = length as'› show False by simp
next
case False
with ‹y ≤ length as› ‹x = length (a#as)› have "y = x - 1" by simp
from ‹targetnode a = n''› ‹distance n'' n' y›
have "distance (targetnode a) n' y" by simp
with ‹valid_edge a›
obtain a' where "sourcenode a = sourcenode a'"
and "distance (targetnode a') n' y" and "valid_edge a'"
and "targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' y ∧
valid_edge a' ∧ targetnode a' = nx)"
by(auto dest:only_one_SOME_dist_edge)
with imp ‹sourcenode a = n› ‹y = x - 1› show False by fastforce
qed
qed
qed
with that show ?thesis by blast
qed
end
end
Theory DataDependence
section ‹Static data dependence›
theory DataDependence imports "../Basic/DynDataDependence" begin
context CFG_wf begin
definition data_dependence :: "'node ⇒ 'var ⇒ 'node ⇒ bool"
("_ influences _ in _" [51,0])
where data_dependences_eq:"n influences V in n' ≡ ∃as. n influences V in n' via as"
lemma data_dependence_def: "n influences V in n' =
(∃a' as'. (V ∈ Def n) ∧ (V ∈ Use n') ∧
(n -a'#as'→* n') ∧ (∀n'' ∈ set (sourcenodes as'). V ∉ Def n''))"
by(auto simp:data_dependences_eq dyn_data_dependence_def)
end
end
Theory Slice
section ‹Static backward slice›
theory Slice
imports Observable Distance DataDependence "../Basic/SemanticsCFG"
begin
locale BackwardSlice =
CFG_wf sourcenode targetnode kind valid_edge Entry Def Use state_val
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val" +
fixes backward_slice :: "'node set ⇒ 'node set"
assumes valid_nodes:"n ∈ backward_slice S ⟹ valid_node n"
and refl:"⟦valid_node n; n ∈ S⟧ ⟹ n ∈ backward_slice S"
and dd_closed:"⟦n' ∈ backward_slice S; n influences V in n'⟧
⟹ n ∈ backward_slice S"
and obs_finite:"finite (obs n (backward_slice S))"
and obs_singleton:"card (obs n (backward_slice S)) ≤ 1"
begin
lemma slice_n_in_obs:
"n ∈ backward_slice S ⟹ obs n (backward_slice S) = {n}"
by(fastforce intro!:n_in_obs dest:valid_nodes)
lemma obs_singleton_disj:
"(∃m. obs n (backward_slice S) = {m}) ∨ obs n (backward_slice S) = {}"
proof -
have "finite(obs n (backward_slice S))" by(rule obs_finite)
show ?thesis
proof(cases "card(obs n (backward_slice S)) = 0")
case True
with ‹finite(obs n (backward_slice S))› have "obs n (backward_slice S) = {}"
by simp
thus ?thesis by simp
next
case False
have "card(obs n (backward_slice S)) ≤ 1" by(rule obs_singleton)
with False have "card(obs n (backward_slice S)) = 1"
by simp
hence "∃m. obs n (backward_slice S) = {m}" by(fastforce dest:card_eq_SucD)
thus ?thesis by simp
qed
qed
lemma obs_singleton_element:
assumes "m ∈ obs n (backward_slice S)" shows "obs n (backward_slice S) = {m}"
proof -
have "(∃m. obs n (backward_slice S) = {m}) ∨ obs n (backward_slice S) = {}"
by(rule obs_singleton_disj)
with ‹m ∈ obs n (backward_slice S)› show ?thesis by fastforce
qed
lemma obs_the_element:
"m ∈ obs n (backward_slice S) ⟹ (THE m. m ∈ obs n (backward_slice S)) = m"
by(fastforce dest:obs_singleton_element)
subsection ‹Traversing the sliced graph›
text ‹‹slice_kind S a› conforms to @{term "kind a"} in the
sliced graph›
definition slice_kind :: "'node set ⇒ 'edge ⇒ 'state edge_kind"
where "slice_kind S a = (let S' = backward_slice S; n = sourcenode a in
(if sourcenode a ∈ S' then kind a
else (case kind a of ⇑f ⇒ ⇑id | (Q)⇩√ ⇒
(if obs (sourcenode a) S' = {} then
(let nx = (SOME n'. ∃a'. n = sourcenode a' ∧ valid_edge a' ∧ targetnode a' = n')
in (if (targetnode a = nx) then (λs. True)⇩√ else (λs. False)⇩√))
else (let m = THE m. m ∈ obs n S' in
(if (∃x. distance (targetnode a) m x ∧ distance n m (x + 1) ∧
(targetnode a = (SOME nx'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ targetnode a' = nx')))
then (λs. True)⇩√ else (λs. False)⇩√
))
))
))"
definition
slice_kinds :: "'node set ⇒ 'edge list ⇒ 'state edge_kind list"
where "slice_kinds S as ≡ map (slice_kind S) as"
lemma slice_kind_in_slice:
"sourcenode a ∈ backward_slice S ⟹ slice_kind S a = kind a"
by(simp add:slice_kind_def)
lemma slice_kind_Upd:
"⟦sourcenode a ∉ backward_slice S; kind a = ⇑f⟧ ⟹ slice_kind S a = ⇑id"
by(simp add:slice_kind_def)
lemma slice_kind_Pred_empty_obs_SOME:
"⟦sourcenode a ∉ backward_slice S; kind a = (Q)⇩√;
obs (sourcenode a) (backward_slice S) = {};
targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧ valid_edge a' ∧
targetnode a' = n')⟧
⟹ slice_kind S a = (λs. True)⇩√"
by(simp add:slice_kind_def)
lemma slice_kind_Pred_empty_obs_not_SOME:
"⟦sourcenode a ∉ backward_slice S; kind a = (Q)⇩√;
obs (sourcenode a) (backward_slice S) = {};
targetnode a ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧ valid_edge a' ∧
targetnode a' = n')⟧
⟹ slice_kind S a = (λs. False)⇩√"
by(simp add:slice_kind_def)
lemma slice_kind_Pred_obs_nearer_SOME:
assumes "sourcenode a ∉ backward_slice S" and "kind a = (Q)⇩√"
and "m ∈ obs (sourcenode a) (backward_slice S)"
and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
and "targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ targetnode a' = n')"
shows "slice_kind S a = (λs. True)⇩√"
proof -
from ‹m ∈ obs (sourcenode a) (backward_slice S)›
have "m = (THE m. m ∈ obs (sourcenode a) (backward_slice S))"
by(rule obs_the_element[THEN sym])
with assms show ?thesis
by(fastforce simp:slice_kind_def Let_def)
qed
lemma slice_kind_Pred_obs_nearer_not_SOME:
assumes "sourcenode a ∉ backward_slice S" and "kind a = (Q)⇩√"
and "m ∈ obs (sourcenode a) (backward_slice S)"
and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
and "targetnode a ≠ (SOME nx'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ targetnode a' = nx')"
shows "slice_kind S a = (λs. False)⇩√"
proof -
from ‹m ∈ obs (sourcenode a) (backward_slice S)›
have "m = (THE m. m ∈ obs (sourcenode a) (backward_slice S))"
by(rule obs_the_element[THEN sym])
with assms show ?thesis
by(fastforce dest:distance_det simp:slice_kind_def Let_def)
qed
lemma slice_kind_Pred_obs_not_nearer:
assumes "sourcenode a ∉ backward_slice S" and "kind a = (Q)⇩√"
and in_obs:"m ∈ obs (sourcenode a) (backward_slice S)"
and dist:"distance (sourcenode a) m (x + 1)"
"¬ distance (targetnode a) m x"
shows "slice_kind S a = (λs. False)⇩√"
proof -
from in_obs have the:"m = (THE m. m ∈ obs (sourcenode a) (backward_slice S))"
by(rule obs_the_element[THEN sym])
from dist have "¬ (∃x. distance (targetnode a) m x ∧
distance (sourcenode a) m (x + 1))"
by(fastforce dest:distance_det)
with ‹sourcenode a ∉ backward_slice S› ‹kind a = (Q)⇩√› in_obs the show ?thesis
by(fastforce simp:slice_kind_def Let_def)
qed
lemma kind_Predicate_notin_slice_slice_kind_Predicate:
assumes "kind a = (Q)⇩√" and "sourcenode a ∉ backward_slice S"
obtains Q' where "slice_kind S a = (Q')⇩√" and "Q' = (λs. False) ∨ Q' = (λs. True)"
proof(atomize_elim)
show "∃Q'. slice_kind S a = (Q')⇩√ ∧ (Q' = (λs. False) ∨ Q' = (λs. True))"
proof(cases "obs (sourcenode a) (backward_slice S) = {}")
case True
show ?thesis
proof(cases "targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')")
case True
with ‹sourcenode a ∉ backward_slice S› ‹kind a = (Q)⇩√›
‹obs (sourcenode a) (backward_slice S) = {}›
have "slice_kind S a = (λs. True)⇩√" by(rule slice_kind_Pred_empty_obs_SOME)
thus ?thesis by simp
next
case False
with ‹sourcenode a ∉ backward_slice S› ‹kind a = (Q)⇩√›
‹obs (sourcenode a) (backward_slice S) = {}›
have "slice_kind S a = (λs. False)⇩√"
by(rule slice_kind_Pred_empty_obs_not_SOME)
thus ?thesis by simp
qed
next
case False
then obtain m where "m ∈ obs (sourcenode a) (backward_slice S)" by blast
show ?thesis
proof(cases "∃x. distance (targetnode a) m x ∧
distance (sourcenode a) m (x + 1)")
case True
then obtain x where "distance (targetnode a) m x"
and "distance (sourcenode a) m (x + 1)" by blast
show ?thesis
proof(cases "targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ targetnode a' = n')")
case True
with ‹sourcenode a ∉ backward_slice S› ‹kind a = (Q)⇩√›
‹m ∈ obs (sourcenode a) (backward_slice S)›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
have "slice_kind S a = (λs. True)⇩√"
by(rule slice_kind_Pred_obs_nearer_SOME)
thus ?thesis by simp
next
case False
with ‹sourcenode a ∉ backward_slice S› ‹kind a = (Q)⇩√›
‹m ∈ obs (sourcenode a) (backward_slice S)›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
have "slice_kind S a = (λs. False)⇩√"
by(rule slice_kind_Pred_obs_nearer_not_SOME)
thus ?thesis by simp
qed
next
case False
from ‹m ∈ obs (sourcenode a) (backward_slice S)›
have "m = (THE m. m ∈ obs (sourcenode a) (backward_slice S))"
by(rule obs_the_element[THEN sym])
with ‹sourcenode a ∉ backward_slice S› ‹kind a = (Q)⇩√› False
‹m ∈ obs (sourcenode a) (backward_slice S)›
have "slice_kind S a = (λs. False)⇩√"
by(fastforce simp:slice_kind_def Let_def)
thus ?thesis by simp
qed
qed
qed
lemma only_one_SOME_edge:
assumes "valid_edge a"
shows "∃!a'. sourcenode a = sourcenode a' ∧ valid_edge a' ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
proof(rule ex_ex1I)
show "∃a'. sourcenode a = sourcenode a' ∧ valid_edge a' ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
proof -
have "(∃a'. sourcenode a = sourcenode a' ∧ valid_edge a' ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')) =
(∃n'. ∃a'. sourcenode a = sourcenode a' ∧ valid_edge a' ∧ targetnode a' = n')"
apply(unfold some_eq_ex[of "λn'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n'"])
by simp
also have "…" using ‹valid_edge a› by blast
finally show ?thesis .
qed
next
fix a' ax
assume "sourcenode a = sourcenode a' ∧ valid_edge a' ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
and "sourcenode a = sourcenode ax ∧ valid_edge ax ∧
targetnode ax = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
thus "a' = ax" by(fastforce intro!:edge_det)
qed
lemma slice_kind_only_one_True_edge:
assumes "sourcenode a = sourcenode a'" and "targetnode a ≠ targetnode a'"
and "valid_edge a" and "valid_edge a'" and "slice_kind S a = (λs. True)⇩√"
shows "slice_kind S a' = (λs. False)⇩√"
proof -
from assms obtain Q Q' where "kind a = (Q)⇩√"
and "kind a' = (Q')⇩√" and det:"∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)"
by(auto dest:deterministic)
from ‹valid_edge a› have ex1:"∃!a'. sourcenode a = sourcenode a' ∧ valid_edge a' ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
by(rule only_one_SOME_edge)
show ?thesis
proof(cases "sourcenode a ∈ backward_slice S")
case True
with ‹slice_kind S a = (λs. True)⇩√› ‹kind a = (Q)⇩√› have "Q = (λs. True)"
by(simp add:slice_kind_def Let_def)
with det have "Q' = (λs. False)" by(simp add:fun_eq_iff)
with True ‹kind a' = (Q')⇩√› ‹sourcenode a = sourcenode a'› show ?thesis
by(simp add:slice_kind_def Let_def)
next
case False
hence "sourcenode a ∉ backward_slice S" by simp
thus ?thesis
proof(cases "obs (sourcenode a) (backward_slice S) = {}")
case True
with ‹sourcenode a ∉ backward_slice S› ‹slice_kind S a = (λs. True)⇩√›
‹kind a = (Q)⇩√›
have target:"targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
have "targetnode a' ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
proof(rule ccontr)
assume "¬ targetnode a' ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
hence "targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
by simp
with ex1 target ‹sourcenode a = sourcenode a'› ‹valid_edge a›
‹valid_edge a'› have "a = a'" by blast
with ‹targetnode a ≠ targetnode a'› show False by simp
qed
with ‹sourcenode a ∉ backward_slice S› True ‹kind a' = (Q')⇩√›
‹sourcenode a = sourcenode a'› show ?thesis
by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
next
case False
hence "obs (sourcenode a) (backward_slice S) ≠ {}" .
then obtain m where "m ∈ obs (sourcenode a) (backward_slice S)" by auto
hence "m = (THE m. m ∈ obs (sourcenode a) (backward_slice S))"
by(auto dest:obs_the_element)
with ‹sourcenode a ∉ backward_slice S›
‹obs (sourcenode a) (backward_slice S) ≠ {}›
‹slice_kind S a = (λs. True)⇩√› ‹kind a = (Q)⇩√›
obtain x x' where "distance (targetnode a) m x"
"distance (sourcenode a) m (x + 1)"
and target:"targetnode a = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ targetnode a' = n')"
by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
show ?thesis
proof(cases "distance (targetnode a') m x")
case False
with ‹sourcenode a ∉ backward_slice S› ‹kind a' = (Q')⇩√›
‹m ∈ obs (sourcenode a) (backward_slice S)›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
‹sourcenode a = sourcenode a'› show ?thesis
by(fastforce intro:slice_kind_Pred_obs_not_nearer)
next
case True
from ‹valid_edge a› ‹distance (targetnode a) m x›
‹distance (sourcenode a) m (x + 1)›
have ex1:"∃!a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧ valid_edge a' ∧
targetnode a' = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ targetnode a' = nx)"
by(fastforce intro!:only_one_SOME_dist_edge)
have "targetnode a' ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ targetnode a' = n')"
proof(rule ccontr)
assume "¬ targetnode a' ≠ (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ targetnode a' = n')"
hence "targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') m x ∧
valid_edge a' ∧ targetnode a' = n')"
by simp
with ex1 target ‹sourcenode a = sourcenode a'›
‹valid_edge a› ‹valid_edge a'›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
have "a = a'" by auto
with ‹targetnode a ≠ targetnode a'› show False by simp
qed
with ‹sourcenode a ∉ backward_slice S›
‹kind a' = (Q')⇩√› ‹m ∈ obs (sourcenode a) (backward_slice S)›
‹distance (targetnode a) m x› ‹distance (sourcenode a) m (x + 1)›
True ‹sourcenode a = sourcenode a'› show ?thesis
by(fastforce intro:slice_kind_Pred_obs_nearer_not_SOME)
qed
qed
qed
qed
lemma slice_deterministic:
assumes "valid_edge a" and "valid_edge a'"
and "sourcenode a = sourcenode a'" and "targetnode a ≠ targetnode a'"
obtains Q Q' where "slice_kind S a = (Q)⇩√" and "slice_kind S a' = (Q')⇩√"
and "∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)"
proof(atomize_elim)
from assms obtain Q Q'
where "kind a = (Q)⇩√" and "kind a' = (Q')⇩√"
and det:"∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)"
by(auto dest:deterministic)
from ‹valid_edge a› have ex1:"∃!a'. sourcenode a = sourcenode a' ∧ valid_edge a' ∧
targetnode a' = (SOME n'. ∃a'. sourcenode a = sourcenode a' ∧
valid_edge a' ∧ targetnode a' = n')"
by(rule only_one_SOME_edge)
show "∃Q Q'. slice_kind S a = (Q)⇩√ ∧ slice_kind S a' = (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
proof(cases "sourcenode a ∈ backward_slice S")
case True
with ‹kind a = (Q)⇩√› have "slice_kind S a = (Q)⇩√"
by(simp add:slice_kind_def Let_def)
from True ‹kind a' = (Q')⇩√› ‹sourcenode a = sourcenode a'›
have "slice_kind S a' = (Q')⇩√"
by(simp add:slice_kind_def Let_def)
with ‹slice_kind S a = (Q)⇩√› det show ?thesis by blast
next
case False
with ‹kind a = (Q)⇩√›
have "slice_kind S a = (λs. True)⇩√ ∨ slice_kind S a = (λs. False)⇩√"
by(simp add:slice_kind_def Let_def)
thus ?thesis
proof
assume true:"slice_kind S a = (λs. True)⇩√"
with ‹sourcenode a = sourcenode a'› ‹targetnode a ≠ targetnode a'›
‹valid_edge a› ‹valid_edge a'›
have "slice_kind S a' = (λs. False)⇩√"
by(rule slice_kind_only_one_True_edge)
with true show ?thesis by simp
next
assume false:"slice_kind S a = (λs. False)⇩√"
from False ‹kind a' = (Q')⇩√› ‹sourcenode a = sourcenode a'›
have "slice_kind S a' = (λs. True)⇩√ ∨ slice_kind S a' = (λs. False)⇩√"
by(simp add:slice_kind_def Let_def)
with false show ?thesis by auto
qed
qed
qed
subsection ‹Observable and silent moves›
inductive silent_move ::
"'node set ⇒ ('edge ⇒ 'state edge_kind) ⇒ 'node ⇒ 'state ⇒ 'edge ⇒
'node ⇒ 'state ⇒ bool" ("_,_ ⊢ '(_,_') -_→⇩τ '(_,_')" [51,50,0,0,50,0,0] 51)
where silent_moveI:
"⟦pred (f a) s; transfer (f a) s = s'; sourcenode a ∉ backward_slice S;
valid_edge a⟧
⟹ S,f ⊢ (sourcenode a,s) -a→⇩τ (targetnode a,s')"
inductive silent_moves ::
"'node set ⇒ ('edge ⇒ 'state edge_kind) ⇒ 'node ⇒ 'state ⇒ 'edge list ⇒
'node ⇒ 'state ⇒ bool" ("_,_ ⊢ '(_,_') =_⇒⇩τ '(_,_')" [51,50,0,0,50,0,0] 51)
where silent_moves_Nil: "S,f ⊢ (n,s) =[]⇒⇩τ (n,s)"
| silent_moves_Cons:
"⟦S,f ⊢ (n,s) -a→⇩τ (n',s'); S,f ⊢ (n',s') =as⇒⇩τ (n'',s'')⟧
⟹ S,f ⊢ (n,s) =a#as⇒⇩τ (n'',s'')"
lemma silent_moves_obs_slice:
"⟦S,f ⊢ (n,s) =as⇒⇩τ (n',s'); nx ∈ obs n' (backward_slice S)⟧
⟹ nx ∈ obs n (backward_slice S)"
proof(induct rule:silent_moves.induct)
case silent_moves_Nil thus ?case by simp
next
case (silent_moves_Cons S f n s a n' s' as n'' s'')
from ‹nx ∈ obs n'' (backward_slice S)›
‹nx ∈ obs n'' (backward_slice S) ⟹ nx ∈ obs n' (backward_slice S)›
have obs:"nx ∈ obs n' (backward_slice S)" by simp
from ‹S,f ⊢ (n,s) -a→⇩τ (n',s')›
have "n = sourcenode a" and "n' = targetnode a" and "valid_edge a"
and "n ∉ (backward_slice S)"
by(auto elim:silent_move.cases)
hence "obs n' (backward_slice S) ⊆ obs n (backward_slice S)"
by simp(rule edge_obs_subset,simp+)
with obs show ?case by blast
qed
lemma silent_moves_preds_transfers_path:
"⟦S,f ⊢ (n,s) =as⇒⇩τ (n',s'); valid_node n⟧
⟹ preds (map f as) s ∧ transfers (map f as) s = s' ∧ n -as→* n'"
proof(induct rule:silent_moves.induct)
case silent_moves_Nil thus ?case by(simp add:path.empty_path)
next
case (silent_moves_Cons S f n s a n' s' as n'' s'')
note IH = ‹valid_node n' ⟹
preds (map f as) s' ∧ transfers (map f as) s' = s'' ∧ n' -as→* n''›
from ‹S,f ⊢ (n,s) -a→⇩τ (n',s')› have "pred (f a) s" and "transfer (f a) s = s'"
and "n = sourcenode a" and "n' = targetnode a" and "valid_edge a"
by(auto elim:silent_move.cases)
from ‹n' = targetnode a› ‹valid_edge a› have "valid_node n'" by simp
from IH[OF this] have "preds (map f as) s'" and "transfers (map f as) s' = s''"
and "n' -as→* n''" by simp_all
from ‹n = sourcenode a› ‹n' = targetnode a› ‹valid_edge a› ‹n' -as→* n''›
have "n -a#as→* n''" by(fastforce intro:Cons_path)
with ‹pred (f a) s› ‹preds (map f as) s'› ‹transfer (f a) s = s'›
‹transfers (map f as) s' = s''› show ?case by simp
qed
lemma obs_silent_moves:
assumes "obs n (backward_slice S) = {n'}"
obtains as where "S,slice_kind S ⊢ (n,s) =as⇒⇩τ (n',s)"
proof(atomize_elim)
from ‹obs n (backward_slice S) = {n'}›
have "n' ∈ obs n (backward_slice S)" by simp
then obtain as where "n -as→* n'"
and "∀nx ∈ set(sourcenodes as). nx ∉ (backward_slice S)"
and "n' ∈ (backward_slice S)" by(erule obsE)
from ‹n -as→* n'› obtain x where "distance n n' x" and "x ≤ length as"
by(erule every_path_distance)
from ‹distance n n' x› ‹n' ∈ obs n (backward_slice S)›
show "∃as. S,slice_kind S ⊢ (n,s) =as⇒⇩τ (n',s)"
proof(induct x arbitrary:n s rule:nat.induct)
fix n s assume "distance n n' 0"
then obtain as' where "n -as'→* n'" and "length as' = 0"
by(auto elim:distance.cases)
hence "n -[]→* n'" by(cases as) auto
hence "n = n'" by(fastforce elim:path.cases)
hence "S,slice_kind S ⊢ (n,s) =[]⇒⇩τ (n',s)" by(fastforce intro:silent_moves_Nil)
thus "∃as. S,slice_kind S ⊢ (n,s) =as⇒⇩τ (n',s)" by blast
next
fix x n s
assume "distance n n' (Suc x)" and "n' ∈ obs n (backward_slice S)"
and IH:"⋀n s. ⟦distance n n' x; n' ∈ obs n (backward_slice S)⟧
⟹ ∃as. S,slice_kind S ⊢ (n,s) =as⇒⇩τ (n',s)"
from ‹n' ∈ obs n (backward_slice S)›
have "valid_node n" by(rule in_obs_valid)
with ‹distance n n' (Suc x)›
have "n ≠ n'" by(fastforce elim:distance.cases dest:empty_path)
have "n ∉ backward_slice S"
proof
assume isin:"n ∈ backward_slice S"
with ‹valid_node n› have "obs n (backward_slice S) = {n}"
by(fastforce intro!:n_in_obs)
with ‹n' ∈ obs n (backward_slice S)› ‹n ≠ n'› show False by simp
qed
from ‹distance n n' (Suc x)› obtain a where "valid_edge a"
and "n = sourcenode a" and "distance (targetnode a) n' x"
and target:"targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ targetnode a' = nx)"
by -(erule distance_successor_distance,simp+)
from ‹n' ∈ obs n (backward_slice S)›
have "obs n (backward_slice S) = {n'}"
by(rule obs_singleton_element)
with ‹valid_edge a› ‹n ∉ backward_slice S› ‹n = sourcenode a›
have disj:"obs (targetnode a) (backward_slice S) = {} ∨
obs (targetnode a) (backward_slice S) = {n'}"
by -(drule_tac S="backward_slice S" in edge_obs_subset,auto)
from ‹distance (targetnode a) n' x› obtain asx where "targetnode a -asx→* n'"
and "length asx = x" and "∀as'. targetnode a -as'→* n' ⟶ x ≤ length as'"
by(auto elim:distance.cases)
from ‹targetnode a -asx→* n'› ‹n' ∈ (backward_slice S)›
obtain m where "∃m. m ∈ obs (targetnode a) (backward_slice S)"
by(fastforce elim:path_ex_obs)
with disj have "n' ∈ obs (targetnode a) (backward_slice S)" by fastforce
from IH[OF ‹distance (targetnode a) n' x› this,of "transfer (slice_kind S a) s"]
obtain asx' where
moves:"S,slice_kind S ⊢ (targetnode a,transfer (slice_kind S a) s) =asx'⇒⇩τ
(n',transfer (slice_kind S a) s)" by blast
have "pred (slice_kind S a) s ∧ transfer (slice_kind S a) s = s"
proof(cases "kind a")
case (Update f)
with ‹n ∉ backward_slice S› ‹n = sourcenode a› have "slice_kind S a = ⇑id"
by(fastforce intro:slice_kind_Upd)
thus ?thesis by simp
next
case (Predicate Q)
with ‹n ∉ backward_slice S› ‹n = sourcenode a›
‹n' ∈ obs n (backward_slice S)› ‹distance (targetnode a) n' x›
‹distance n n' (Suc x)› target
have "slice_kind S a = (λs. True)⇩√"
by(fastforce intro:slice_kind_Pred_obs_nearer_SOME)
thus ?thesis by simp
qed
hence "pred (slice_kind S a) s" and "transfer (slice_kind S a) s = s"
by simp_all
with ‹n ∉ backward_slice S› ‹n = sourcenode a› ‹valid_edge a›
have "S,slice_kind S ⊢ (sourcenode a,s) -a→⇩τ
(targetnode a,transfer (slice_kind S a) s)"
by(fastforce intro:silent_moveI)
with moves ‹transfer (slice_kind S a) s = s› ‹n = sourcenode a›
have "S,slice_kind S ⊢ (n,s) =a#asx'⇒⇩τ (n',s)"
by(fastforce intro:silent_moves_Cons)
thus "∃as. S,slice_kind S ⊢ (n,s) =as⇒⇩τ (n',s)" by blast
qed
qed
inductive observable_move ::
"'node set ⇒ ('edge ⇒ 'state edge_kind) ⇒ 'node ⇒ 'state ⇒ 'edge ⇒
'node ⇒ 'state ⇒ bool" ("_,_ ⊢ '(_,_') -_→ '(_,_')" [51,50,0,0,50,0,0] 51)
where observable_moveI:
"⟦pred (f a) s; transfer (f a) s = s'; sourcenode a ∈ backward_slice S;
valid_edge a⟧
⟹ S,f ⊢ (sourcenode a,s) -a→ (targetnode a,s')"
inductive observable_moves ::
"'node set ⇒ ('edge ⇒ 'state edge_kind) ⇒ 'node ⇒ 'state ⇒ 'edge list ⇒
'node ⇒ 'state ⇒ bool" ("_,_ ⊢ '(_,_') =_⇒ '(_,_')" [51,50,0,0,50,0,0] 51)
where observable_moves_snoc:
"⟦S,f ⊢ (n,s) =as⇒⇩τ (n',s'); S,f ⊢ (n',s') -a→ (n'',s'')⟧
⟹ S,f ⊢ (n,s) =as@[a]⇒ (n'',s'')"
lemma observable_move_notempty:
"⟦S,f ⊢ (n,s) =as⇒ (n',s'); as = []⟧ ⟹ False"
by(induct rule:observable_moves.induct,simp)
lemma silent_move_observable_moves:
"⟦S,f ⊢ (n'',s'') =as⇒ (n',s'); S,f ⊢ (n,s) -a→⇩τ (n'',s'')⟧
⟹ S,f ⊢ (n,s) =a#as⇒ (n',s')"
proof(induct rule:observable_moves.induct)
case (observable_moves_snoc S f nx sx as n' s' a' n'' s'')
from ‹S,f ⊢ (n,s) -a→⇩τ (nx,sx)› ‹S,f ⊢ (nx,sx) =as⇒⇩τ (n',s')›
have "S,f ⊢ (n,s) =a#as⇒⇩τ (n',s')" by(rule silent_moves_Cons)
with ‹S,f ⊢ (n',s') -a'→ (n'',s'')›
have "S,f ⊢ (n,s) =(a#as)@[a']⇒ (n'',s'')"
by -(rule observable_moves.observable_moves_snoc)
thus ?case by simp
qed
lemma observable_moves_preds_transfers_path:
"S,f ⊢ (n,s) =as⇒ (n',s')
⟹ preds (map f as) s ∧ transfers (map f as) s = s' ∧ n -as→* n'"
proof(induct rule:observable_moves.induct)
case (observable_moves_snoc S f n s as n' s' a n'' s'')
have "valid_node n"
proof(cases as)
case Nil
with ‹S,f ⊢ (n,s) =as⇒⇩τ (n',s')› have "n = n'" and "s = s'"
by(auto elim:silent_moves.cases)
with ‹S,f ⊢ (n',s') -a→ (n'',s'')› show ?thesis
by(fastforce elim:observable_move.cases)
next
case (Cons a' as')
with ‹S,f ⊢ (n,s) =as⇒⇩τ (n',s')› show ?thesis
by(fastforce elim:silent_moves.cases silent_move.cases)
qed
with ‹S,f ⊢ (n,s) =as⇒⇩τ (n',s')›
have "preds (map f as) s" and "transfers (map f as) s = s'"
and "n -as→* n'" by(auto dest:silent_moves_preds_transfers_path)
from ‹S,f ⊢ (n',s') -a→ (n'',s'')› have "pred (f a) s'"
and "transfer (f a) s' = s''" and "n' = sourcenode a" and "n'' = targetnode a"
and "valid_edge a"
by(auto elim:observable_move.cases)
from ‹n' = sourcenode a› ‹n'' = targetnode a› ‹valid_edge a›
have "n' -[a]→* n''" by(fastforce intro:path.intros)
with ‹n -as→* n'› have "n -as@[a]→* n''" by(rule path_Append)
with ‹preds (map f as) s› ‹pred (f a) s'› ‹transfer (f a) s' = s''›
‹transfers (map f as) s = s'›
show ?case by(simp add:transfers_split preds_split)
qed
subsection ‹Relevant variables›
inductive_set relevant_vars :: "'node set ⇒ 'node ⇒ 'var set" ("rv _")
for S :: "'node set" and n :: "'node"
where rvI:
"⟦n -as→* n'; n' ∈ backward_slice S; V ∈ Use n';
∀nx ∈ set(sourcenodes as). V ∉ Def nx⟧
⟹ V ∈ rv S n"
lemma rvE:
assumes rv:"V ∈ rv S n"
obtains as n' where "n -as→* n'" and "n' ∈ backward_slice S" and "V ∈ Use n'"
and "∀nx ∈ set(sourcenodes as). V ∉ Def nx"
using rv
by(atomize_elim,auto elim!:relevant_vars.cases)
lemma eq_obs_in_rv:
assumes obs_eq:"obs n (backward_slice S) = obs n' (backward_slice S)"
and "x ∈ rv S n" shows "x ∈ rv S n'"
proof -
from ‹x ∈ rv S n› obtain as m
where "n -as→* m" and "m ∈ backward_slice S" and "x ∈ Use m"
and "∀nx∈set (sourcenodes as). x ∉ Def nx"
by(erule rvE)
from ‹n -as→* m› have "valid_node m" by(fastforce dest:path_valid_node)
from ‹n -as→* m› ‹m ∈ backward_slice S›
have "∃nx as' as''. nx ∈ obs n (backward_slice S) ∧ n -as'→* nx ∧
nx -as''→* m ∧ as = as'@as''"
proof(cases "∀nx ∈ set(sourcenodes as). nx ∉ backward_slice S")
case True
with ‹n -as→* m› ‹m ∈ backward_slice S› have "m ∈ obs n (backward_slice S)"
by -(rule obs_elem)
with ‹n -as→* m› ‹valid_node m› show ?thesis by(blast intro:empty_path)
next
case False
hence "∃nx ∈ set(sourcenodes as). nx ∈ backward_slice S" by simp
then obtain nx' ns ns' where "sourcenodes as = ns@nx'#ns'"
and "nx' ∈ backward_slice S"
and "∀x ∈ set ns. x ∉ backward_slice S"
by(fastforce elim!:split_list_first_propE)
from ‹sourcenodes as = ns@nx'#ns'›
obtain as' a' as'' where "ns = sourcenodes as'"
and "as = as'@a'#as''" and "sourcenode a' = nx'"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹n -as→* m› ‹as = as'@a'#as''› ‹sourcenode a' = nx'›
have "n -as'→* nx'" and "valid_edge a'" and "targetnode a' -as''→* m"
by(fastforce dest:path_split)+
with ‹sourcenode a' = nx'› have "nx' -a'#as''→* m" by(fastforce intro:Cons_path)
from ‹n -as'→* nx'› ‹nx' ∈ backward_slice S›
‹∀x ∈ set ns. x ∉ backward_slice S› ‹ns = sourcenodes as'›
have "nx' ∈ obs n (backward_slice S)"
by(fastforce intro:obs_elem)
with ‹n -as'→* nx'› ‹nx' -a'#as''→* m› ‹as = as'@a'#as''› show ?thesis by blast
qed
then obtain nx as' as'' where "nx ∈ obs n (backward_slice S)"
and "n -as'→* nx" and "nx -as''→* m" and "as = as'@as''"
by blast
from ‹nx ∈ obs n (backward_slice S)› obs_eq
have "nx ∈ obs n' (backward_slice S)" by auto
then obtain asx where "n' -asx→* nx"
and "∀ni ∈ set(sourcenodes asx). ni ∉ backward_slice S"
and "nx ∈ backward_slice S"
by(erule obsE)
from ‹as = as'@as''› ‹∀nx∈set (sourcenodes as). x ∉ Def nx›
have "∀ni∈set (sourcenodes as''). x ∉ Def ni"
by(auto simp:sourcenodes_def)
from ‹∀ni ∈ set(sourcenodes asx). ni ∉ backward_slice S› ‹n' -asx→* nx›
have "∀ni ∈ set(sourcenodes asx). x ∉ Def ni"
proof(induct asx arbitrary:n')
case Nil thus ?case by(simp add:sourcenodes_def)
next
case (Cons ax' asx')
note IH = ‹⋀n'. ⟦∀ni∈set (sourcenodes asx'). ni ∉ backward_slice S;
n' -asx'→* nx⟧
⟹ ∀ni∈set (sourcenodes asx'). x ∉ Def ni›
from ‹n' -ax'#asx'→* nx› have "n' -[]@ax'#asx'→* nx" by simp
hence "targetnode ax' -asx'→* nx" and "n' = sourcenode ax'"
by(fastforce dest:path_split)+
from ‹∀ni∈set (sourcenodes (ax'#asx')). ni ∉ backward_slice S›
have all:"∀ni∈set (sourcenodes asx'). ni ∉ backward_slice S"
and "sourcenode ax' ∉ backward_slice S"
by(auto simp:sourcenodes_def)
from IH[OF all ‹targetnode ax' -asx'→* nx›]
have "∀ni∈set (sourcenodes asx'). x ∉ Def ni" .
with ‹∀ni∈set (sourcenodes as''). x ∉ Def ni›
have "∀ni∈set (sourcenodes (asx'@as'')). x ∉ Def ni"
by(auto simp:sourcenodes_def)
from ‹n' -ax'#asx'→* nx› ‹nx -as''→* m› have "n' -(ax'#asx')@as''→* m"
by-(rule path_Append)
hence "n' -ax'#asx'@as''→* m" by simp
have "x ∉ Def (sourcenode ax')"
proof
assume "x ∈ Def (sourcenode ax')"
with ‹x ∈ Use m› ‹∀ni∈set (sourcenodes (asx'@as'')). x ∉ Def ni›
‹n' -ax'#asx'@as''→* m› ‹n' = sourcenode ax'›
have "n' influences x in m"
by(auto simp:data_dependence_def)
with ‹m ∈ backward_slice S› dd_closed have "n' ∈ backward_slice S"
by(auto simp:dd_closed)
with ‹n' = sourcenode ax'› ‹sourcenode ax' ∉ backward_slice S›
show False by simp
qed
with ‹∀ni∈set (sourcenodes (asx'@as'')). x ∉ Def ni›
show ?case by(simp add:sourcenodes_def)
qed
with ‹∀ni∈set (sourcenodes as''). x ∉ Def ni›
have "∀ni∈set (sourcenodes (asx@as'')). x ∉ Def ni"
by(auto simp:sourcenodes_def)
from ‹n' -asx→* nx› ‹nx -as''→* m› have "n' -asx@as''→* m" by(rule path_Append)
with ‹m ∈ backward_slice S› ‹x ∈ Use m›
‹∀ni∈set (sourcenodes (asx@as'')). x ∉ Def ni› show "x ∈ rv S n'" by -(rule rvI)
qed
lemma closed_eq_obs_eq_rvs:
fixes S :: "'node set"
assumes "valid_node n" and "valid_node n'"
and obs_eq:"obs n (backward_slice S) = obs n' (backward_slice S)"
shows "rv S n = rv S n'"
proof
show "rv S n ⊆ rv S n'"
proof
fix x assume "x ∈ rv S n"
with ‹valid_node n› obs_eq show "x ∈ rv S n'" by -(rule eq_obs_in_rv)
qed
next
show "rv S n' ⊆ rv S n"
proof
fix x assume "x ∈ rv S n'"
with ‹valid_node n'› obs_eq[THEN sym] show "x ∈ rv S n" by -(rule eq_obs_in_rv)
qed
qed
lemma rv_edge_slice_kinds:
assumes "valid_edge a" and "sourcenode a = n" and "targetnode a = n''"
and "∀V∈rv S n. state_val s V = state_val s' V"
and "preds (slice_kinds S (a#as)) s" and "preds (slice_kinds S (a#asx)) s'"
shows "∀V∈rv S n''. state_val (transfer (slice_kind S a) s) V =
state_val (transfer (slice_kind S a) s') V"
proof
fix V assume "V ∈ rv S n''"
show "state_val (transfer (slice_kind S a) s) V =
state_val (transfer (slice_kind S a) s') V"
proof(cases "V ∈ Def n")
case True
show ?thesis
proof(cases "sourcenode a ∈ backward_slice S")
case True
hence "slice_kind S a = kind a" by(rule slice_kind_in_slice)
with ‹preds (slice_kinds S (a#as)) s› have "pred (kind a) s"
by(simp add:slice_kinds_def)
from ‹slice_kind S a = kind a› ‹preds (slice_kinds S (a#asx)) s'›
have "pred (kind a) s'"
by(simp add:slice_kinds_def)
from ‹valid_edge a› ‹sourcenode a = n› have "n -[]→* n"
by(fastforce intro:empty_path)
with True ‹sourcenode a = n› have "∀V ∈ Use n. V ∈ rv S n"
by(fastforce intro:rvI simp:sourcenodes_def)
with ‹∀V∈rv S n. state_val s V = state_val s' V› ‹sourcenode a = n›
have "∀V ∈ Use (sourcenode a). state_val s V = state_val s' V" by blast
from ‹valid_edge a› this ‹pred (kind a) s› ‹pred (kind a) s'›
have "∀V ∈ Def (sourcenode a). state_val (transfer (kind a) s) V =
state_val (transfer (kind a) s') V"
by(rule CFG_edge_transfer_uses_only_Use)
with ‹V ∈ Def n› ‹sourcenode a = n› ‹slice_kind S a = kind a›
show ?thesis by simp
next
case False
from ‹V ∈ rv S n''› obtain xs nx where "n'' -xs→* nx"
and "nx ∈ backward_slice S" and "V ∈ Use nx"
and "∀nx' ∈ set(sourcenodes xs). V ∉ Def nx'" by(erule rvE)
from ‹valid_edge a› ‹sourcenode a = n› ‹targetnode a = n''›
‹n'' -xs→* nx›
have "n -a#xs→* nx" by -(rule path.Cons_path)
with ‹V ∈ Def n› ‹V ∈ Use nx› ‹∀nx' ∈ set(sourcenodes xs). V ∉ Def nx'›
have "n influences V in nx" by(fastforce simp:data_dependence_def)
with ‹nx ∈ backward_slice S› have "n ∈ backward_slice S"
by(rule dd_closed)
with ‹sourcenode a = n› False have False by simp
thus ?thesis by simp
qed
next
case False
from ‹V ∈ rv S n''› obtain xs nx where "n'' -xs→* nx"
and "nx ∈ backward_slice S" and "V ∈ Use nx"
and "∀nx' ∈ set(sourcenodes xs). V ∉ Def nx'" by(erule rvE)
from ‹valid_edge a› ‹sourcenode a = n› ‹targetnode a = n''› ‹n'' -xs→* nx›
have "n -a#xs→* nx" by -(rule path.Cons_path)
from False ‹∀nx' ∈ set(sourcenodes xs). V ∉ Def nx'› ‹sourcenode a = n›
have "∀nx' ∈ set(sourcenodes (a#xs)). V ∉ Def nx'"
by(simp add:sourcenodes_def)
with ‹n -a#xs→* nx› ‹nx ∈ backward_slice S› ‹V ∈ Use nx›
have "V ∈ rv S n" by(rule rvI)
show ?thesis
proof(cases "kind a")
case (Predicate Q)
show ?thesis
proof(cases "sourcenode a ∈ backward_slice S")
case True
with Predicate have "slice_kind S a = (Q)⇩√"
by(simp add:slice_kind_in_slice)
with ‹∀V∈rv S n. state_val s V = state_val s' V› ‹V ∈ rv S n›
show ?thesis by simp
next
case False
with Predicate obtain Q' where "slice_kind S a = (Q')⇩√"
by -(erule kind_Predicate_notin_slice_slice_kind_Predicate)
with ‹∀V∈rv S n. state_val s V = state_val s' V› ‹V ∈ rv S n›
show ?thesis by simp
qed
next
case (Update f)
show ?thesis
proof(cases "sourcenode a ∈ backward_slice S")
case True
hence "slice_kind S a = kind a" by(rule slice_kind_in_slice)
from Update have "pred (kind a) s" by simp
with ‹valid_edge a› ‹sourcenode a = n› ‹V ∉ Def n›
have "state_val (transfer (kind a) s) V = state_val s V"
by(fastforce intro:CFG_edge_no_Def_equal)
from Update have "pred (kind a) s'" by simp
with ‹valid_edge a› ‹sourcenode a = n› ‹V ∉ Def n›
have "state_val (transfer (kind a) s') V = state_val s' V"
by(fastforce intro:CFG_edge_no_Def_equal)
with ‹∀V∈rv S n. state_val s V = state_val s' V› ‹V ∈ rv S n›
‹state_val (transfer (kind a) s) V = state_val s V›
‹slice_kind S a = kind a›
show ?thesis by fastforce
next
case False
with Update have "slice_kind S a = ⇑id" by -(rule slice_kind_Upd)
with ‹∀V∈rv S n. state_val s V = state_val s' V› ‹V ∈ rv S n›
show ?thesis by fastforce
qed
qed
qed
qed
lemma rv_branching_edges_slice_kinds_False:
assumes "valid_edge a" and "valid_edge ax"
and "sourcenode a = n" and "sourcenode ax = n"
and "targetnode a = n''" and "targetnode ax ≠ n''"
and "preds (slice_kinds S (a#as)) s" and "preds (slice_kinds S (ax#asx)) s'"
and "∀V∈rv S n. state_val s V = state_val s' V"
shows False
proof -
from ‹valid_edge a› ‹valid_edge ax› ‹sourcenode a = n› ‹sourcenode ax = n›
‹targetnode a = n''› ‹targetnode ax ≠ n''›
obtain Q Q' where "kind a = (Q)⇩√" and "kind ax = (Q')⇩√"
and "∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)"
by(auto dest:deterministic)
from ‹valid_edge a› ‹valid_edge ax› ‹sourcenode a = n› ‹sourcenode ax = n›
‹targetnode a = n''› ‹targetnode ax ≠ n''›
obtain P P' where "slice_kind S a = (P)⇩√"
and "slice_kind S ax = (P')⇩√"
and "∀s. (P s ⟶ ¬ P' s) ∧ (P' s ⟶ ¬ P s)"
by -(erule slice_deterministic,auto)
show ?thesis
proof(cases "sourcenode a ∈ backward_slice S")
case True
hence "slice_kind S a = kind a" by(rule slice_kind_in_slice)
with ‹preds (slice_kinds S (a#as)) s› ‹kind a = (Q)⇩√›
‹slice_kind S a = (P)⇩√› have "pred (kind a) s"
by(simp add:slice_kinds_def)
from True ‹sourcenode a = n› ‹sourcenode ax = n›
have "slice_kind S ax = kind ax" by(fastforce simp:slice_kind_in_slice)
with ‹preds (slice_kinds S (ax#asx)) s'› ‹kind ax = (Q')⇩√›
‹slice_kind S ax = (P')⇩√› have "pred (kind ax) s'"
by(simp add:slice_kinds_def)
with ‹kind ax = (Q')⇩√› have "Q' s'" by simp
from ‹valid_edge a› ‹sourcenode a = n› have "n -[]→* n"
by(fastforce intro:empty_path)
with True ‹sourcenode a = n› have "∀V ∈ Use n. V ∈ rv S n"
by(fastforce intro:rvI simp:sourcenodes_def)
with ‹∀V∈rv S n. state_val s V = state_val s' V› ‹sourcenode a = n›
have "∀V ∈ Use (sourcenode a). state_val s V = state_val s' V" by blast
with ‹valid_edge a› ‹pred (kind a) s› have "pred (kind a) s'"
by(rule CFG_edge_Uses_pred_equal)
with ‹kind a = (Q)⇩√› have "Q s'" by simp
with ‹Q' s'› ‹∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s)› have False by simp
thus ?thesis by simp
next
case False
with ‹kind a = (Q)⇩√› ‹slice_kind S a = (P)⇩√›
have "P = (λs. False) ∨ P = (λs. True)"
by(fastforce elim:kind_Predicate_notin_slice_slice_kind_Predicate)
with ‹slice_kind S a = (P)⇩√› ‹preds (slice_kinds S (a#as)) s›
have "P = (λs. True)" by(fastforce simp:slice_kinds_def)
from ‹kind ax = (Q')⇩√› ‹slice_kind S ax = (P')⇩√›
‹sourcenode a = n› ‹sourcenode ax = n› False
have "P' = (λs. False) ∨ P' = (λs. True)"
by(fastforce elim:kind_Predicate_notin_slice_slice_kind_Predicate)
with ‹slice_kind S ax = (P')⇩√› ‹preds (slice_kinds S (ax#asx)) s'›
have "P' = (λs. True)" by(fastforce simp:slice_kinds_def)
with ‹P = (λs. True)› ‹∀s. (P s ⟶ ¬ P' s) ∧ (P' s ⟶ ¬ P s)›
have False by blast
thus ?thesis by simp
qed
qed
subsection ‹The set ‹WS››
inductive_set WS :: "'node set ⇒ (('node × 'state) × ('node × 'state)) set"
for S :: "'node set"
where WSI:"⟦obs n (backward_slice S) = obs n' (backward_slice S);
∀V ∈ rv S n. state_val s V = state_val s' V;
valid_node n; valid_node n'⟧
⟹ ((n,s),(n',s')) ∈ WS S"
lemma WSD:
"((n,s),(n',s')) ∈ WS S
⟹ obs n (backward_slice S) = obs n' (backward_slice S) ∧
(∀V ∈ rv S n. state_val s V = state_val s' V) ∧
valid_node n ∧ valid_node n'"
by(auto elim:WS.cases)
lemma WS_silent_move:
assumes "((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S" and "S,kind ⊢ (n⇩1,s⇩1) -a→⇩τ (n⇩1',s⇩1')"
and "obs n⇩1' (backward_slice S) ≠ {}" shows "((n⇩1',s⇩1'),(n⇩2,s⇩2)) ∈ WS S"
proof -
from ‹((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S› have "valid_node n⇩1" and "valid_node n⇩2"
by(auto dest:WSD)
from ‹S,kind ⊢ (n⇩1,s⇩1) -a→⇩τ (n⇩1',s⇩1')› have "sourcenode a = n⇩1"
and "targetnode a = n⇩1'" and "transfer (kind a) s⇩1 = s⇩1'"
and "n⇩1 ∉ backward_slice S" and "valid_edge a" and "pred (kind a) s⇩1"
by(auto elim:silent_move.cases)
from ‹targetnode a = n⇩1'› ‹valid_edge a› have "valid_node n⇩1'"
by(auto simp:valid_node_def)
have "(∃m. obs n⇩1' (backward_slice S) = {m}) ∨ obs n⇩1' (backward_slice S) = {}"
by(rule obs_singleton_disj)
with ‹obs n⇩1' (backward_slice S) ≠ {}› obtain n
where "obs n⇩1' (backward_slice S) = {n}" by fastforce
hence "n ∈ obs n⇩1' (backward_slice S)" by auto
then obtain as where "n⇩1' -as→* n"
and "∀nx ∈ set(sourcenodes as). nx ∉ (backward_slice S)"
and "n ∈ (backward_slice S)" by(erule obsE)
from ‹n⇩1' -as→* n› ‹valid_edge a› ‹sourcenode a = n⇩1› ‹targetnode a = n⇩1'›
have "n⇩1 -a#as→* n" by(rule Cons_path)
moreover
from ‹∀nx ∈ set(sourcenodes as). nx ∉ (backward_slice S)› ‹sourcenode a = n⇩1›
‹n⇩1 ∉ backward_slice S›
have "∀nx ∈ set(sourcenodes (a#as)). nx ∉ (backward_slice S)"
by(simp add:sourcenodes_def)
ultimately have "n ∈ obs n⇩1 (backward_slice S)" using ‹n ∈ (backward_slice S)›
by(rule obs_elem)
hence "obs n⇩1 (backward_slice S) = {n}" by(rule obs_singleton_element)
with ‹obs n⇩1' (backward_slice S) = {n}›
have "obs n⇩1 (backward_slice S) = obs n⇩1' (backward_slice S)"
by simp
with ‹valid_node n⇩1› ‹valid_node n⇩1'› have "rv S n⇩1 = rv S n⇩1'"
by(rule closed_eq_obs_eq_rvs)
from ‹n ∈ obs n⇩1 (backward_slice S)› ‹((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S›
have "obs n⇩1 (backward_slice S) = obs n⇩2 (backward_slice S)"
and "∀V ∈ rv S n⇩1. state_val s⇩1 V = state_val s⇩2 V"
by(fastforce dest:WSD)+
from ‹obs n⇩1 (backward_slice S) = obs n⇩2 (backward_slice S)›
‹obs n⇩1 (backward_slice S) = {n}› ‹obs n⇩1' (backward_slice S) = {n}›
have "obs n⇩1' (backward_slice S) = obs n⇩2 (backward_slice S)" by simp
have "∀V ∈ rv S n⇩1'. state_val s⇩1' V = state_val s⇩2 V"
proof
fix V assume "V ∈ rv S n⇩1'"
with ‹rv S n⇩1 = rv S n⇩1'› have "V ∈ rv S n⇩1" by simp
then obtain as n' where "n⇩1 -as→* n'" and "n' ∈ (backward_slice S)"
and "V ∈ Use n'" and "∀nx ∈ set(sourcenodes as). V ∉ Def nx"
by(erule rvE)
with ‹n⇩1 ∉ backward_slice S› have "V ∉ Def n⇩1"
by(auto elim:path.cases simp:sourcenodes_def)
with ‹valid_edge a› ‹sourcenode a = n⇩1› ‹pred (kind a) s⇩1›
have "state_val (transfer (kind a) s⇩1) V = state_val s⇩1 V"
by(fastforce intro:CFG_edge_no_Def_equal)
with ‹transfer (kind a) s⇩1 = s⇩1'› have "state_val s⇩1' V = state_val s⇩1 V" by simp
from ‹V ∈ rv S n⇩1› ‹∀V ∈ rv S n⇩1. state_val s⇩1 V = state_val s⇩2 V›
have "state_val s⇩1 V = state_val s⇩2 V" by simp
with ‹state_val s⇩1' V = state_val s⇩1 V›
show "state_val s⇩1' V = state_val s⇩2 V" by simp
qed
with ‹obs n⇩1' (backward_slice S) = obs n⇩2 (backward_slice S)›
‹valid_node n⇩1'› ‹valid_node n⇩2› show ?thesis by(fastforce intro:WSI)
qed
lemma WS_silent_moves:
"⟦S,f ⊢ (n⇩1,s⇩1) =as⇒⇩τ (n⇩1',s⇩1'); ((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S; f = kind;
obs n⇩1' (backward_slice S) ≠ {}⟧
⟹ ((n⇩1',s⇩1'),(n⇩2,s⇩2)) ∈ WS S"
proof(induct rule:silent_moves.induct)
case silent_moves_Nil thus ?case by simp
next
case (silent_moves_Cons S f n s a n' s' as n'' s'')
note IH = ‹⟦((n',s'),(n⇩2,s⇩2)) ∈ WS S; f = kind; obs n'' (backward_slice S) ≠ {}⟧
⟹ ((n'',s''),(n⇩2,s⇩2)) ∈ WS S›
from ‹S,f ⊢ (n',s') =as⇒⇩τ (n'',s'')› ‹obs n'' (backward_slice S) ≠ {}›
have "obs n' (backward_slice S) ≠ {}" by(fastforce dest:silent_moves_obs_slice)
with ‹((n,s),(n⇩2,s⇩2)) ∈ WS S› ‹S,f ⊢ (n,s) -a→⇩τ (n',s')› ‹f = kind›
have "((n',s'),(n⇩2,s⇩2)) ∈ WS S" by -(rule WS_silent_move,simp+)
from IH[OF this ‹f = kind› ‹obs n'' (backward_slice S) ≠ {}›]
show ?case .
qed
lemma WS_observable_move:
assumes "((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S" and "S,kind ⊢ (n⇩1,s⇩1) -a→ (n⇩1',s⇩1')"
obtains as where "((n⇩1',s⇩1'),(n⇩1',transfer (slice_kind S a) s⇩2)) ∈ WS S"
and "S,slice_kind S ⊢ (n⇩2,s⇩2) =as@[a]⇒ (n⇩1',transfer (slice_kind S a) s⇩2)"
proof(atomize_elim)
from ‹((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S› have "valid_node n⇩1" by(auto dest:WSD)
from ‹S,kind ⊢ (n⇩1,s⇩1) -a→ (n⇩1',s⇩1')› have [simp]:"n⇩1 = sourcenode a"
and [simp]:"n⇩1' = targetnode a" and "pred (kind a) s⇩1"
and "transfer (kind a) s⇩1 = s⇩1'" and "n⇩1 ∈ (backward_slice S)"
and "valid_edge a" and "pred (kind a) s⇩1"
by(auto elim:observable_move.cases)
from ‹valid_edge a› have "valid_node n⇩1'" by(auto simp:valid_node_def)
from ‹valid_node n⇩1› ‹n⇩1 ∈ (backward_slice S)›
have "obs n⇩1 (backward_slice S) = {n⇩1}" by(rule n_in_obs)
with ‹((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S› have "obs n⇩2 (backward_slice S) = {n⇩1}"
and "∀V ∈ rv S n⇩1. state_val s⇩1 V = state_val s⇩2 V" by(auto dest:WSD)
from ‹valid_node n⇩1› have "n⇩1 -[]→* n⇩1" by(rule empty_path)
with ‹n⇩1 ∈ (backward_slice S)› have "∀V ∈ Use n⇩1. V ∈ rv S n⇩1"
by(fastforce intro:rvI simp:sourcenodes_def)
with ‹∀V ∈ rv S n⇩1. state_val s⇩1 V = state_val s⇩2 V›
have "∀V ∈ Use n⇩1. state_val s⇩1 V = state_val s⇩2 V" by blast
with ‹valid_edge a› ‹pred (kind a) s⇩1› have "pred (kind a) s⇩2"
by(fastforce intro:CFG_edge_Uses_pred_equal)
with ‹n⇩1 ∈ (backward_slice S)› have "pred (slice_kind S a) s⇩2"
by(simp add:slice_kind_in_slice)
from ‹n⇩1 ∈ (backward_slice S)› obtain s⇩2'
where "transfer (slice_kind S a) s⇩2 = s⇩2'"
by(simp add:slice_kind_in_slice)
with ‹pred (slice_kind S a) s⇩2› ‹n⇩1 ∈ (backward_slice S)› ‹valid_edge a›
have "S,slice_kind S ⊢ (n⇩1,s⇩2) -a→ (n⇩1',s⇩2')"
by(fastforce intro:observable_moveI)
from ‹obs n⇩2 (backward_slice S) = {n⇩1}›
obtain as where "S,slice_kind S ⊢ (n⇩2,s⇩2) =as⇒⇩τ (n⇩1,s⇩2)"
by(erule obs_silent_moves)
with ‹S,slice_kind S ⊢ (n⇩1,s⇩2) -a→ (n⇩1',s⇩2')›
have "S,slice_kind S ⊢ (n⇩2,s⇩2) =as@[a]⇒ (n⇩1',s⇩2')"
by -(rule observable_moves_snoc)
have "∀V ∈ rv S n⇩1'. state_val s⇩1' V = state_val s⇩2' V"
proof
fix V assume rv:"V ∈ rv S n⇩1'"
show "state_val s⇩1' V = state_val s⇩2' V"
proof(cases "V ∈ Def n⇩1")
case True
thus ?thesis
proof(cases "kind a")
case (Update f)
with ‹transfer (kind a) s⇩1 = s⇩1'› have "s⇩1' = f s⇩1" by simp
from Update[THEN sym] ‹n⇩1 ∈ (backward_slice S)›
have "slice_kind S a = ⇑f"
by(fastforce intro:slice_kind_in_slice)
with ‹transfer (slice_kind S a) s⇩2 = s⇩2'› have "s⇩2' = f s⇩2" by simp
from ‹valid_edge a› ‹∀V ∈ Use n⇩1. state_val s⇩1 V = state_val s⇩2 V›
True Update ‹s⇩1' = f s⇩1› ‹s⇩2' = f s⇩2› show ?thesis
by(fastforce dest:CFG_edge_transfer_uses_only_Use)
next
case (Predicate Q)
with ‹transfer (kind a) s⇩1 = s⇩1'› have "s⇩1' = s⇩1" by simp
from Predicate[THEN sym] ‹n⇩1 ∈ (backward_slice S)›
have "slice_kind S a = (Q)⇩√"
by(fastforce intro:slice_kind_in_slice)
with ‹transfer (slice_kind S a) s⇩2 = s⇩2'› have "s⇩2' = s⇩2" by simp
with ‹valid_edge a› ‹∀V ∈ Use n⇩1. state_val s⇩1 V = state_val s⇩2 V›
True Predicate ‹s⇩1' = s⇩1› ‹pred (kind a) s⇩1› ‹pred (kind a) s⇩2›
show ?thesis by(auto dest:CFG_edge_transfer_uses_only_Use)
qed
next
case False
with ‹valid_edge a› ‹transfer (kind a) s⇩1 = s⇩1'›[THEN sym]
‹pred (kind a) s⇩1› ‹pred (kind a) s⇩2›
have "state_val s⇩1' V = state_val s⇩1 V"
by(fastforce intro:CFG_edge_no_Def_equal)
have "state_val s⇩2' V = state_val s⇩2 V"
proof(cases "kind a")
case (Update f)
with ‹n⇩1 ∈ (backward_slice S)› have "slice_kind S a = kind a"
by(fastforce intro:slice_kind_in_slice)
with ‹valid_edge a› ‹transfer (slice_kind S a) s⇩2 = s⇩2'›[THEN sym]
False ‹pred (kind a) s⇩2›
show ?thesis by(fastforce intro:CFG_edge_no_Def_equal)
next
case (Predicate Q)
with ‹transfer (slice_kind S a) s⇩2 = s⇩2'› have "s⇩2 = s⇩2'"
by(cases "slice_kind S a",
auto split:if_split_asm simp:slice_kind_def Let_def)
thus ?thesis by simp
qed
from rv obtain as' nx where "n⇩1' -as'→* nx"
and "nx ∈ (backward_slice S)"
and "V ∈ Use nx" and "∀nx ∈ set(sourcenodes as'). V ∉ Def nx"
by(erule rvE)
from ‹∀nx ∈ set(sourcenodes as'). V ∉ Def nx› False
have "∀nx ∈ set(sourcenodes (a#as')). V ∉ Def nx"
by(auto simp:sourcenodes_def)
from ‹valid_edge a› ‹n⇩1' -as'→* nx› have "n⇩1 -a#as'→* nx"
by(fastforce intro:Cons_path)
with ‹nx ∈ (backward_slice S)› ‹V ∈ Use nx›
‹∀nx ∈ set(sourcenodes (a#as')). V ∉ Def nx›
have "V ∈ rv S n⇩1" by -(rule rvI)
with ‹∀V ∈ rv S n⇩1. state_val s⇩1 V = state_val s⇩2 V›
‹state_val s⇩1' V = state_val s⇩1 V› ‹state_val s⇩2' V = state_val s⇩2 V›
show ?thesis by fastforce
qed
qed
with ‹valid_node n⇩1'› have "((n⇩1',s⇩1'),(n⇩1',s⇩2')) ∈ WS S" by(fastforce intro:WSI)
with ‹S,slice_kind S ⊢ (n⇩2,s⇩2) =as@[a]⇒ (n⇩1',s⇩2')›
‹transfer (slice_kind S a) s⇩2 = s⇩2'›
show "∃as. ((n⇩1',s⇩1'),(n⇩1',transfer (slice_kind S a) s⇩2)) ∈ WS S ∧
S,slice_kind S ⊢ (n⇩2,s⇩2) =as@[a]⇒ (n⇩1',transfer (slice_kind S a) s⇩2)"
by blast
qed
definition is_weak_sim ::
"(('node × 'state) × ('node × 'state)) set ⇒ 'node set ⇒ bool"
where "is_weak_sim R S ≡
∀n⇩1 s⇩1 n⇩2 s⇩2 n⇩1' s⇩1' as. ((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ R ∧ S,kind ⊢ (n⇩1,s⇩1) =as⇒ (n⇩1',s⇩1')
⟶ (∃n⇩2' s⇩2' as'. ((n⇩1',s⇩1'),(n⇩2',s⇩2')) ∈ R ∧
S,slice_kind S ⊢ (n⇩2,s⇩2) =as'⇒ (n⇩2',s⇩2'))"
lemma WS_weak_sim:
assumes "((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S"
and "S,kind ⊢ (n⇩1,s⇩1) =as⇒ (n⇩1',s⇩1')"
shows "((n⇩1',s⇩1'),(n⇩1',transfer (slice_kind S (last as)) s⇩2)) ∈ WS S ∧
(∃as'. S,slice_kind S ⊢ (n⇩2,s⇩2) =as'@[last as]⇒
(n⇩1',transfer (slice_kind S (last as)) s⇩2))"
proof -
from ‹S,kind ⊢ (n⇩1,s⇩1) =as⇒ (n⇩1',s⇩1')› obtain a' as' n' s'
where "S,kind ⊢ (n⇩1,s⇩1) =as'⇒⇩τ (n',s')"
and "S,kind ⊢ (n',s') -a'→ (n⇩1',s⇩1')" and "as = as'@[a']"
by(fastforce elim:observable_moves.cases)
from ‹S,kind ⊢ (n',s') -a'→ (n⇩1',s⇩1')› have "obs n' (backward_slice S) = {n'}"
by(fastforce elim:observable_move.cases intro!:n_in_obs)
hence "obs n' (backward_slice S) ≠ {}" by fast
with ‹S,kind ⊢ (n⇩1,s⇩1) =as'⇒⇩τ (n',s')› ‹((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S›
have "((n',s'),(n⇩2,s⇩2)) ∈ WS S"
by -(rule WS_silent_moves,simp+)
with ‹S,kind ⊢ (n',s') -a'→ (n⇩1',s⇩1')› obtain asx
where "((n⇩1',s⇩1'),(n⇩1',transfer (slice_kind S a') s⇩2)) ∈ WS S"
and "S,slice_kind S ⊢ (n⇩2,s⇩2) =asx@[a']⇒
(n⇩1',transfer (slice_kind S a') s⇩2)"
by(fastforce elim:WS_observable_move)
with ‹as = as'@[a']› show
"((n⇩1',s⇩1'),(n⇩1',transfer (slice_kind S (last as)) s⇩2)) ∈ WS S ∧
(∃as'. S,slice_kind S ⊢ (n⇩2,s⇩2) =as'@[last as]⇒
(n⇩1',transfer (slice_kind S (last as)) s⇩2))" by simp blast
qed
text ‹The following lemma states the correctness of static intraprocedural slicing:\\
the simulation ‹WS S› is a desired weak simulation›
theorem WS_is_weak_sim:"is_weak_sim (WS S) S"
by(fastforce dest:WS_weak_sim simp:is_weak_sim_def)
subsection ‹@{term "n -as→* n'"} and transitive closure of
@{term "S,f ⊢ (n,s) =as⇒⇩τ (n',s')"}›
inductive trans_observable_moves ::
"'node set ⇒ ('edge ⇒ 'state edge_kind) ⇒ 'node ⇒ 'state ⇒ 'edge list ⇒
'node ⇒ 'state ⇒ bool" ("_,_ ⊢ '(_,_') =_⇒* '(_,_')" [51,50,0,0,50,0,0] 51)
where tom_Nil:
"S,f ⊢ (n,s) =[]⇒* (n,s)"
| tom_Cons:
"⟦S,f ⊢ (n,s) =as⇒ (n',s'); S,f ⊢ (n',s') =as'⇒* (n'',s'')⟧
⟹ S,f ⊢ (n,s) =(last as)#as'⇒* (n'',s'')"
definition slice_edges :: "'node set ⇒ 'edge list ⇒ 'edge list"
where "slice_edges S as ≡ [a ← as. sourcenode a ∈ backward_slice S]"
lemma silent_moves_no_slice_edges:
"S,f ⊢ (n,s) =as⇒⇩τ (n',s') ⟹ slice_edges S as = []"
by(induct rule:silent_moves.induct,auto elim:silent_move.cases simp:slice_edges_def)
lemma observable_moves_last_slice_edges:
"S,f ⊢ (n,s) =as⇒ (n',s') ⟹ slice_edges S as = [last as]"
by(induct rule:observable_moves.induct,
fastforce dest:silent_moves_no_slice_edges elim:observable_move.cases
simp:slice_edges_def)
lemma slice_edges_no_nodes_in_slice:
"slice_edges S as = []
⟹ ∀nx ∈ set(sourcenodes as). nx ∉ (backward_slice S)"
proof(induct as)
case Nil thus ?case by(simp add:slice_edges_def sourcenodes_def)
next
case (Cons a' as')
note IH = ‹slice_edges S as' = [] ⟹
∀nx∈set (sourcenodes as'). nx ∉ backward_slice S›
from ‹slice_edges S (a'#as') = []› have "slice_edges S as' = []"
and "sourcenode a' ∉ backward_slice S"
by(auto simp:slice_edges_def split:if_split_asm)
from IH[OF ‹slice_edges S as' = []›] ‹sourcenode a' ∉ backward_slice S›
show ?case by(simp add:sourcenodes_def)
qed
lemma sliced_path_determ:
"⟦n -as→* n'; n -as'→* n'; slice_edges S as = slice_edges S as';
preds (slice_kinds S as) s; preds (slice_kinds S as') s'; n' ∈ S;
∀V ∈ rv S n. state_val s V = state_val s' V⟧ ⟹ as = as'"
proof(induct arbitrary:as' s s' rule:path.induct)
case (empty_path n)
from ‹slice_edges S [] = slice_edges S as'›
have "∀nx ∈ set(sourcenodes as'). nx ∉ (backward_slice S)"
by(fastforce intro!:slice_edges_no_nodes_in_slice simp:slice_edges_def)
with ‹n -as'→* n› show ?case
proof(induct nx≡"n" as' nx'≡"n" rule:path.induct)
case (Cons_path n'' as a)
from ‹valid_node n› ‹n ∈ S› have "n ∈ backward_slice S" by(rule refl)
with ‹∀nx∈set (sourcenodes (a # as)). nx ∉ backward_slice S›
‹sourcenode a = n›
have False by(simp add:sourcenodes_def)
thus ?case by simp
qed simp
next
case (Cons_path n'' as n' a n)
note IH = ‹⋀as' s s'. ⟦n'' -as'→* n'; slice_edges S as = slice_edges S as';
preds (slice_kinds S as) s; preds (slice_kinds S as') s'; n' ∈ S;
∀V∈rv S n''. state_val s V = state_val s' V⟧ ⟹ as = as'›
show ?case
proof(cases as')
case Nil
with ‹n -as'→* n'› have "n = n'" by fastforce
from Nil ‹slice_edges S (a#as) = slice_edges S as'› ‹sourcenode a = n›
have "n ∉ backward_slice S" by(fastforce simp:slice_edges_def)
from ‹valid_edge a› ‹sourcenode a = n› ‹n = n'› ‹n' ∈ S›
have "n ∈ backward_slice S" by(fastforce intro:refl)
with ‹n = n'› ‹n ∉ backward_slice S› have False by simp
thus ?thesis by simp
next
case (Cons ax asx)
with ‹n -as'→* n'› have "n = sourcenode ax" and "valid_edge ax"
and "targetnode ax -asx→* n'" by(auto elim:path_split_Cons)
show ?thesis
proof(cases "targetnode ax = n''")
case True
with ‹targetnode ax -asx→* n'› have "n'' -asx→* n'" by simp
from ‹valid_edge ax› ‹valid_edge a› ‹n = sourcenode ax› ‹sourcenode a = n›
True ‹targetnode a = n''› have "ax = a" by(fastforce intro:edge_det)
from ‹slice_edges S (a#as) = slice_edges S as'› Cons
‹n = sourcenode ax› ‹sourcenode a = n›
have "slice_edges S as = slice_edges S asx"
by(cases "n ∈ backward_slice S")(auto simp:slice_edges_def)
from ‹preds (slice_kinds S (a#as)) s›
have preds1:"preds (slice_kinds S as) (transfer (slice_kind S a) s)"
by(simp add:slice_kinds_def)
from ‹preds (slice_kinds S as') s'› Cons ‹ax = a›
have preds2:"preds (slice_kinds S asx) (transfer (slice_kind S a) s')"
by(simp add:slice_kinds_def)
from ‹valid_edge a› ‹sourcenode a = n› ‹targetnode a = n''›
‹preds (slice_kinds S (a#as)) s› ‹preds (slice_kinds S as') s'›
‹ax = a› Cons ‹∀V∈rv S n. state_val s V = state_val s' V›
have "∀V∈rv S n''. state_val (transfer (slice_kind S a) s) V =
state_val (transfer (slice_kind S a) s') V"
by -(rule rv_edge_slice_kinds,auto)
from IH[OF ‹n'' -asx→* n'› ‹slice_edges S as = slice_edges S asx›
preds1 preds2 ‹n' ∈ S› this] Cons ‹ax = a› show ?thesis by simp
next
case False
with ‹valid_edge a› ‹valid_edge ax› ‹sourcenode a = n› ‹n = sourcenode ax›
‹targetnode a = n''› ‹preds (slice_kinds S (a#as)) s›
‹preds (slice_kinds S as') s'› Cons
‹∀V∈rv S n. state_val s V = state_val s' V›
have False by -(erule rv_branching_edges_slice_kinds_False,auto)
thus ?thesis by simp
qed
qed
qed
lemma path_trans_observable_moves:
assumes "n -as→* n'" and "preds (kinds as) s" and "transfers (kinds as) s = s'"
obtains n'' s'' as' as'' where "S,kind ⊢ (n,s) =slice_edges S as⇒* (n'',s'')"
and "S,kind ⊢ (n'',s'') =as'⇒⇩τ (n',s')"
and "slice_edges S as = slice_edges S as''" and "n -as''@as'→* n'"
proof(atomize_elim)
from ‹n -as→* n'› ‹preds (kinds as) s› ‹transfers (kinds as) s = s'›
show "∃n'' s'' as' as''.
S,kind ⊢ (n,s) =slice_edges S as⇒* (n'',s'') ∧
S,kind ⊢ (n'',s'') =as'⇒⇩τ (n',s') ∧ slice_edges S as = slice_edges S as'' ∧
n -as''@as'→* n'"
proof(induct arbitrary:s rule:path.induct)
case (empty_path n)
from ‹transfers (kinds []) s = s'› have "s = s'" by(simp add:kinds_def)
have "S,kind ⊢ (n,s) =[]⇒* (n,s)" by(rule tom_Nil)
have "S,kind ⊢ (n,s) =[]⇒⇩τ (n,s)" by(rule silent_moves_Nil)
with ‹S,kind ⊢ (n,s) =[]⇒* (n,s)› ‹s = s'› ‹valid_node n›
show ?case
apply(rule_tac x="n" in exI)
apply(rule_tac x="s" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="[]" in exI)
by(fastforce intro:path.empty_path simp:slice_edges_def)
next
case (Cons_path n'' as n' a n)
note IH = ‹⋀s. ⟦preds (kinds as) s; transfers (kinds as) s = s'⟧
⟹ ∃nx s'' as' as''. S,kind ⊢ (n'',s) =slice_edges S as⇒* (nx,s'') ∧
S,kind ⊢ (nx,s'') =as'⇒⇩τ (n',s') ∧
slice_edges S as = slice_edges S as'' ∧ n'' -as''@as'→* n'›
from ‹preds (kinds (a#as)) s› ‹transfers (kinds (a#as)) s = s'›
have "preds (kinds as) (transfer (kind a) s)"
"transfers (kinds as) (transfer (kind a) s) = s'" by(simp_all add:kinds_def)
from IH[OF this] obtain nx sx asx asx'
where "S,kind ⊢ (n'',transfer (kind a) s) =slice_edges S as⇒* (nx,sx)"
and "S,kind ⊢ (nx,sx) =asx⇒⇩τ (n',s')"
and "slice_edges S as = slice_edges S asx'"
and "n'' -asx'@asx→* n'"
by clarsimp
from ‹preds (kinds (a#as)) s› have "pred (kind a) s" by(simp add:kinds_def)
show ?case
proof(cases "n ∈ backward_slice S")
case True
with ‹valid_edge a› ‹sourcenode a = n› ‹targetnode a = n''› ‹pred (kind a) s›
have "S,kind ⊢ (n,s) -a→ (n'',transfer (kind a) s)"
by(fastforce intro:observable_moveI)
hence "S,kind ⊢ (n,s) =[]@[a]⇒ (n'',transfer (kind a) s)"
by(fastforce intro:observable_moves_snoc silent_moves_Nil)
with ‹S,kind ⊢ (n'',transfer (kind a) s) =slice_edges S as⇒* (nx,sx)›
have "S,kind ⊢ (n,s) =a#slice_edges S as⇒* (nx,sx)"
by(fastforce dest:tom_Cons)
with ‹S,kind ⊢ (nx,sx) =asx⇒⇩τ (n',s')›
‹slice_edges S as = slice_edges S asx'› ‹n'' -asx'@asx→* n'›
‹sourcenode a = n› ‹valid_edge a› ‹targetnode a = n''› True
show ?thesis
apply(rule_tac x="nx" in exI)
apply(rule_tac x="sx" in exI)
apply(rule_tac x="asx" in exI)
apply(rule_tac x="a#asx'" in exI)
by(auto intro:path.Cons_path simp:slice_edges_def)
next
case False
with ‹valid_edge a› ‹sourcenode a = n› ‹targetnode a = n''› ‹pred (kind a) s›
have "S,kind ⊢ (n,s) -a→⇩τ (n'',transfer (kind a) s)"
by(fastforce intro:silent_moveI)
from ‹S,kind ⊢ (n'',transfer (kind a) s) =slice_edges S as⇒* (nx,sx)›
obtain f s'' asx'' where "S,f ⊢ (n'',s'') =asx''⇒* (nx,sx)"
and "f = kind" and "s'' = transfer (kind a) s"
and "asx'' = slice_edges S as" by simp
from ‹S,f ⊢ (n'',s'') =asx''⇒* (nx,sx)› ‹f = kind›
‹asx'' = slice_edges S as› ‹s'' = transfer (kind a) s›
‹S,kind ⊢ (n,s) -a→⇩τ (n'',transfer (kind a) s)›
‹S,kind ⊢ (nx,sx) =asx⇒⇩τ (n',s')› ‹slice_edges S as = slice_edges S asx'›
‹n'' -asx'@asx→* n'› False
show ?thesis
proof(induct rule:trans_observable_moves.induct)
case (tom_Nil S f ni si)
have "S,kind ⊢ (n,s) =[]⇒* (n,s)" by(rule trans_observable_moves.tom_Nil)
from ‹S,kind ⊢ (ni,si) =asx⇒⇩τ (n',s')›
‹S,kind ⊢ (n,s) -a→⇩τ (ni,transfer (kind a) s)›
‹si = transfer (kind a) s›
have "S,kind ⊢ (n,s) =a#asx⇒⇩τ (n',s')"
by(fastforce intro:silent_moves_Cons)
with ‹valid_edge a› ‹sourcenode a = n›
have "n -a#asx→* n'" by(fastforce dest:silent_moves_preds_transfers_path)
with ‹sourcenode a = n› ‹valid_edge a› ‹targetnode a = n''›
‹[] = slice_edges S as› ‹n ∉ backward_slice S›
‹S,kind ⊢ (n,s) =a#asx⇒⇩τ (n',s')›
show ?case
apply(rule_tac x="n" in exI)
apply(rule_tac x="s" in exI)
apply(rule_tac x="a#asx" in exI)
apply(rule_tac x="[]" in exI)
by(fastforce simp:slice_edges_def intro:trans_observable_moves.tom_Nil)
next
case (tom_Cons S f ni si asi ni' si' asi' n'' s'')
from ‹S,f ⊢ (ni,si) =asi⇒ (ni',si')› have "asi ≠ []"
by(fastforce dest:observable_move_notempty)
from ‹S,kind ⊢ (n,s) -a→⇩τ (ni,transfer (kind a) s)›
have "valid_edge a" and "sourcenode a = n" and "targetnode a = ni"
by(auto elim:silent_move.cases)
from ‹S,kind ⊢ (n,s) -a→⇩τ (ni,transfer (kind a) s)› ‹f = kind›
‹si = transfer (kind a) s› ‹S,f ⊢ (ni,si) =asi⇒ (ni',si')›
have "S,f ⊢ (n,s) =a#asi⇒ (ni',si')"
by(fastforce intro:silent_move_observable_moves)
with ‹S,f ⊢ (ni',si') =asi'⇒* (n'',s'')›
have "S,f ⊢ (n,s) =(last (a#asi))#asi'⇒* (n'',s'')"
by -(rule trans_observable_moves.tom_Cons)
with ‹f = kind› ‹last asi # asi' = slice_edges S as› ‹n ∉ backward_slice S›
‹S,kind ⊢ (n'',s'') =asx⇒⇩τ (n',s')› ‹sourcenode a = n› ‹asi ≠ []›
‹ni -asx'@asx→* n'› ‹slice_edges S as = slice_edges S asx'›
‹valid_edge a› ‹sourcenode a = n› ‹targetnode a = ni›
show ?case
apply(rule_tac x="n''" in exI)
apply(rule_tac x="s''" in exI)
apply(rule_tac x="asx" in exI)
apply(rule_tac x="a#asx'" in exI)
by(auto intro:path.Cons_path simp:slice_edges_def)
qed
qed
qed
qed
lemma WS_weak_sim_trans:
assumes "((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S"
and "S,kind ⊢ (n⇩1,s⇩1) =as⇒* (n⇩1',s⇩1')" and "as ≠ []"
shows "((n⇩1',s⇩1'),(n⇩1',transfers (slice_kinds S as) s⇩2)) ∈ WS S ∧
S,slice_kind S ⊢ (n⇩2,s⇩2) =as⇒* (n⇩1',transfers (slice_kinds S as) s⇩2)"
proof -
obtain f where "f = kind" by simp
with ‹S,kind ⊢ (n⇩1,s⇩1) =as⇒* (n⇩1',s⇩1')›
have "S,f ⊢ (n⇩1,s⇩1) =as⇒* (n⇩1',s⇩1')" by simp
from ‹S,f ⊢ (n⇩1,s⇩1) =as⇒* (n⇩1',s⇩1')› ‹((n⇩1,s⇩1),(n⇩2,s⇩2)) ∈ WS S› ‹as ≠ []› ‹f = kind›
show "((n⇩1',s⇩1'),(n⇩1',transfers (slice_kinds S as) s⇩2)) ∈ WS S ∧
S,slice_kind S ⊢ (n⇩2,s⇩2) =as⇒* (n⇩1',transfers (slice_kinds S as) s⇩2)"
proof(induct arbitrary:n⇩2 s⇩2 rule:trans_observable_moves.induct)
case tom_Nil thus ?case by simp
next
case (tom_Cons S f n s as n' s' as' n'' s'')
note IH = ‹⋀n⇩2 s⇩2. ⟦((n',s'),(n⇩2,s⇩2)) ∈ WS S; as' ≠ []; f = kind⟧
⟹ ((n'',s''),(n'',transfers (slice_kinds S as') s⇩2)) ∈ WS S ∧
S,slice_kind S ⊢ (n⇩2,s⇩2) =as'⇒* (n'',transfers (slice_kinds S as') s⇩2)›
from ‹S,f ⊢ (n,s) =as⇒ (n',s')›
obtain asx ax nx sx where "S,f ⊢ (n,s) =asx⇒⇩τ (nx,sx)"
and "S,f ⊢ (nx,sx) -ax→ (n',s')" and "as = asx@[ax]"
by(fastforce elim:observable_moves.cases)
from ‹S,f ⊢ (nx,sx) -ax→ (n',s')› have "obs nx (backward_slice S) = {nx}"
by(fastforce intro!:n_in_obs elim:observable_move.cases)
with ‹S,f ⊢ (n,s) =asx⇒⇩τ (nx,sx)› ‹((n,s),(n⇩2,s⇩2)) ∈ WS S› ‹f = kind›
have "((nx,sx),(n⇩2,s⇩2)) ∈ WS S" by(fastforce intro:WS_silent_moves)
with ‹S,f ⊢ (nx,sx) -ax→ (n',s')› ‹f = kind›
obtain asx' where "((n',s'),(n',transfer (slice_kind S ax) s⇩2)) ∈ WS S"
and "S,slice_kind S ⊢ (n⇩2,s⇩2) =asx'@[ax]⇒
(n',transfer (slice_kind S ax) s⇩2)"
by(fastforce elim:WS_observable_move)
show ?case
proof(cases "as' = []")
case True
with ‹S,f ⊢ (n',s') =as'⇒* (n'',s'')› have "n' = n'' ∧ s' = s''"
by(fastforce elim:trans_observable_moves.cases dest:observable_move_notempty)
from ‹S,slice_kind S ⊢ (n⇩2,s⇩2) =asx'@[ax]⇒
(n',transfer (slice_kind S ax) s⇩2)›
have "S,slice_kind S ⊢ (n⇩2,s⇩2) =(last (asx'@[ax]))#[]⇒*
(n',transfer (slice_kind S ax) s⇩2)"
by(fastforce intro:trans_observable_moves.intros)
with ‹((n',s'),(n',transfer (slice_kind S ax) s⇩2)) ∈ WS S› ‹as = asx@[ax]›
‹n' = n'' ∧ s' = s''› True
show ?thesis by(fastforce simp:slice_kinds_def)
next
case False
from IH[OF ‹((n',s'),(n',transfer (slice_kind S ax) s⇩2)) ∈ WS S› this
‹f = kind›]
have "((n'',s''),(n'',transfers (slice_kinds S as')
(transfer (slice_kind S ax) s⇩2))) ∈ WS S"
and "S,slice_kind S ⊢ (n',transfer (slice_kind S ax) s⇩2)
=as'⇒* (n'',transfers (slice_kinds S as')
(transfer (slice_kind S ax) s⇩2))" by simp_all
with ‹S,slice_kind S ⊢ (n⇩2,s⇩2) =asx'@[ax]⇒
(n',transfer (slice_kind S ax) s⇩2)›
have "S,slice_kind S ⊢ (n⇩2,s⇩2) =(last (asx'@[ax]))#as'⇒*
(n'',transfers (slice_kinds S as') (transfer (slice_kind S ax) s⇩2))"
by(fastforce intro:trans_observable_moves.tom_Cons)
with ‹((n'',s''),(n'',transfers (slice_kinds S as')
(transfer (slice_kind S ax) s⇩2))) ∈ WS S› False ‹as = asx@[ax]›
show ?thesis by(fastforce simp:slice_kinds_def)
qed
qed
qed
lemma transfers_slice_kinds_slice_edges:
"transfers (slice_kinds S (slice_edges S as)) s = transfers (slice_kinds S as) s"
proof(induct as arbitrary:s)
case Nil thus ?case by(simp add:slice_kinds_def slice_edges_def)
next
case (Cons a' as')
note IH = ‹⋀s. transfers (slice_kinds S (slice_edges S as')) s =
transfers (slice_kinds S as') s›
show ?case
proof(cases "sourcenode a' ∈ backward_slice S")
case True
hence eq:"transfers (slice_kinds S (slice_edges S (a'#as'))) s
= transfers (slice_kinds S (slice_edges S as'))
(transfer (slice_kind S a') s)"
by(simp add:slice_edges_def slice_kinds_def)
have "transfers (slice_kinds S (a'#as')) s
= transfers (slice_kinds S as') (transfer (slice_kind S a') s)"
by(simp add:slice_kinds_def)
with eq IH[of "transfer (slice_kind S a') s"] show ?thesis by simp
next
case False
hence eq:"transfers (slice_kinds S (slice_edges S (a'#as'))) s
= transfers (slice_kinds S (slice_edges S as')) s"
by(simp add:slice_edges_def slice_kinds_def)
from False have "transfer (slice_kind S a') s = s"
by(cases "kind a'",auto simp:slice_kind_def Let_def)
hence "transfers (slice_kinds S (a'#as')) s
= transfers (slice_kinds S as') s"
by(simp add:slice_kinds_def)
with eq IH[of s] show ?thesis by simp
qed
qed
lemma trans_observable_moves_preds:
assumes "S,f ⊢ (n,s) =as⇒* (n',s')" and "valid_node n"
obtains as' where "preds (map f as') s" and "slice_edges S as' = as"
and "n -as'→* n'"
proof(atomize_elim)
from ‹S,f ⊢ (n,s) =as⇒* (n',s')› ‹valid_node n›
show "∃as'. preds (map f as') s ∧ slice_edges S as' = as ∧ n -as'→* n'"
proof(induct rule:trans_observable_moves.induct)
case tom_Nil thus ?case
by(rule_tac x="[]" in exI,fastforce intro:empty_path simp:slice_edges_def)
next
case (tom_Cons S f n s as n' s' as' n'' s'')
note IH = ‹valid_node n'
⟹ ∃asx. preds (map f asx) s' ∧ slice_edges S asx = as' ∧ n' -asx→* n''›
from ‹S,f ⊢ (n,s) =as⇒ (n',s')›
have "preds (map f as) s" and "transfers (map f as) s = s'"
and "n -as→* n'"
by(fastforce dest:observable_moves_preds_transfers_path)+
from ‹n -as→* n'› have "valid_node n'" by(fastforce dest:path_valid_node)
from ‹S,f ⊢ (n,s) =as⇒ (n',s')› have "slice_edges S as = [last as]"
by(rule observable_moves_last_slice_edges)
from IH[OF ‹valid_node n'›]
obtain asx where "preds (map f asx) s'" and "slice_edges S asx = as'"
and "n' -asx→* n''"
by blast
from ‹n -as→* n'› ‹n' -asx→* n''› have "n -as@asx→* n''" by(rule path_Append)
from ‹preds (map f asx) s'› ‹transfers (map f as) s = s'›[THEN sym]
‹preds (map f as) s›
have "preds (map f (as@asx)) s" by(simp add:preds_split)
with ‹slice_edges S as = [last as]› ‹slice_edges S asx = as'›
‹n -as@asx→* n''› show ?case
by(rule_tac x="as@asx" in exI,auto simp:slice_edges_def)
qed
qed
lemma exists_sliced_path_preds:
assumes "n -as→* n'" and "slice_edges S as = []" and "n' ∈ backward_slice S"
obtains as' where "n -as'→* n'" and "preds (slice_kinds S as') s"
and "slice_edges S as' = []"
proof(atomize_elim)
from ‹slice_edges S as = []›
have "∀nx ∈ set(sourcenodes as). nx ∉ (backward_slice S)"
by(rule slice_edges_no_nodes_in_slice)
with ‹n -as→* n'› ‹n' ∈ backward_slice S› have "n' ∈ obs n (backward_slice S)"
by -(rule obs_elem)
hence "obs n (backward_slice S) = {n'}" by(rule obs_singleton_element)
from ‹n -as→* n'› have "valid_node n" and "valid_node n'"
by(fastforce dest:path_valid_node)+
from ‹n -as→* n'› obtain x where "distance n n' x" and "x ≤ length as"
by(erule every_path_distance)
from ‹distance n n' x› ‹obs n (backward_slice S) = {n'}›
show "∃as'. n -as'→* n' ∧ preds (slice_kinds S as') s ∧
slice_edges S as' = []"
proof(induct x arbitrary:n rule:nat.induct)
case zero
from ‹distance n n' 0› have "n = n'" by(fastforce elim:distance.cases)
with ‹valid_node n'› show ?case
by(rule_tac x="[]" in exI,
auto intro:empty_path simp:slice_kinds_def slice_edges_def)
next
case (Suc x)
note IH = ‹⋀n. ⟦distance n n' x; obs n (backward_slice S) = {n'}⟧
⟹ ∃as'. n -as'→* n' ∧ preds (slice_kinds S as') s ∧
slice_edges S as' = []›
from ‹distance n n' (Suc x)› obtain a
where "valid_edge a" and "n = sourcenode a"
and "distance (targetnode a) n' x"
and target:"targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ targetnode a' = nx)"
by(auto elim:distance_successor_distance)
have "n ∉ backward_slice S"
proof
assume "n ∈ backward_slice S"
from ‹valid_edge a› ‹n = sourcenode a› have "valid_node n" by simp
with ‹n ∈ backward_slice S› have "obs n (backward_slice S) = {n}"
by -(rule n_in_obs)
with ‹obs n (backward_slice S) = {n'}› have "n = n'" by simp
with ‹valid_node n› have "n -[]→* n'" by(fastforce intro:empty_path)
with ‹distance n n' (Suc x)› show False
by(fastforce elim:distance.cases)
qed
from ‹distance (targetnode a) n' x› ‹n' ∈ backward_slice S›
obtain m where "m ∈ obs (targetnode a) (backward_slice S)"
by(fastforce elim:distance.cases path_ex_obs)
from ‹valid_edge a› ‹n ∉ backward_slice S› ‹n = sourcenode a›
have "obs (targetnode a) (backward_slice S) ⊆
obs (sourcenode a) (backward_slice S)"
by -(rule edge_obs_subset,auto)
with ‹m ∈ obs (targetnode a) (backward_slice S)› ‹n = sourcenode a›
‹obs n (backward_slice S) = {n'}›
have "n' ∈ obs (targetnode a) (backward_slice S)" by auto
hence "obs (targetnode a) (backward_slice S) = {n'}"
by(rule obs_singleton_element)
from IH[OF ‹distance (targetnode a) n' x› this]
obtain as where "targetnode a -as→* n'" and "preds (slice_kinds S as) s"
and "slice_edges S as = []" by blast
from ‹targetnode a -as→* n'› ‹valid_edge a› ‹n = sourcenode a›
have "n -a#as→* n'" by(fastforce intro:Cons_path)
from ‹slice_edges S as = []› ‹n ∉ backward_slice S› ‹n = sourcenode a›
have "slice_edges S (a#as) = []" by(simp add:slice_edges_def)
show ?case
proof(cases "kind a")
case (Update f)
with ‹n ∉ backward_slice S› ‹n = sourcenode a› have "slice_kind S a = ⇑id"
by(fastforce intro:slice_kind_Upd)
hence "transfer (slice_kind S a) s = s" and "pred (slice_kind S a) s"
by simp_all
with ‹preds (slice_kinds S as) s› have "preds (slice_kinds S (a#as)) s"
by(simp add:slice_kinds_def)
with ‹n -a#as→* n'› ‹slice_edges S (a#as) = []› show ?thesis
by blast
next
case (Predicate Q)
with ‹n ∉ backward_slice S› ‹n = sourcenode a› ‹distance n n' (Suc x)›
‹obs n (backward_slice S) = {n'}› ‹distance (targetnode a) n' x›
‹targetnode a = (SOME nx. ∃a'. sourcenode a = sourcenode a' ∧
distance (targetnode a') n' x ∧
valid_edge a' ∧ targetnode a' = nx)›
have "slice_kind S a = (λs. True)⇩√"
by(fastforce intro:slice_kind_Pred_obs_nearer_SOME)
hence "transfer (slice_kind S a) s = s" and "pred (slice_kind S a) s"
by simp_all
with ‹preds (slice_kinds S as) s› have "preds (slice_kinds S (a#as)) s"
by(simp add:slice_kinds_def)
with ‹n -a#as→* n'› ‹slice_edges S (a#as) = []› show ?thesis by blast
qed
qed
qed
theorem fundamental_property_of_static_slicing:
assumes path:"n -as→* n'" and preds:"preds (kinds as) s" and "n' ∈ S"
obtains as' where "preds (slice_kinds S as') s"
and "(∀V ∈ Use n'. state_val (transfers (slice_kinds S as') s) V =
state_val (transfers (kinds as) s) V)"
and "slice_edges S as = slice_edges S as'" and "n -as'→* n'"
proof(atomize_elim)
from path preds obtain n'' s'' as' as''
where "S,kind ⊢ (n,s) =slice_edges S as⇒* (n'',s'')"
and "S,kind ⊢ (n'',s'') =as'⇒⇩τ (n',transfers (kinds as) s)"
and "slice_edges S as = slice_edges S as''"
and "n -as''@as'→* n'"
by -(erule_tac S="S" in path_trans_observable_moves,auto)
from path have "valid_node n" and "valid_node n'"
by(fastforce dest:path_valid_node)+
from ‹valid_node n› have "((n,s),(n,s)) ∈ WS S" by(fastforce intro:WSI)
from ‹valid_node n'› ‹n' ∈ S› have "obs n' (backward_slice S) = {n'}"
by(fastforce intro!:n_in_obs refl)
from ‹valid_node n'› have "n'-[]→* n'" by(fastforce intro:empty_path)
with ‹valid_node n'› ‹n' ∈ S› have "∀V ∈ Use n'. V ∈ rv S n'"
by(fastforce intro:rvI refl simp:sourcenodes_def)
show "∃as'. preds (slice_kinds S as') s ∧
(∀V ∈ Use n'. state_val (transfers (slice_kinds S as') s) V =
state_val (transfers (kinds as) s) V) ∧
slice_edges S as = slice_edges S as' ∧ n -as'→* n'"
proof(cases "slice_edges S as = []")
case True
hence "preds (slice_kinds S []) s" and "slice_edges S [] = slice_edges S as"
by(simp_all add:slice_kinds_def slice_edges_def)
from ‹S,kind ⊢ (n,s) =slice_edges S as⇒* (n'',s'')› True
have "n = n''" and "s = s''"
by(fastforce elim:trans_observable_moves.cases)+
with ‹S,kind ⊢ (n'',s'') =as'⇒⇩τ (n',transfers (kinds as) s)›
have "S,kind ⊢ (n,s) =as'⇒⇩τ (n',transfers (kinds as) s)" by simp
with ‹valid_node n› have "n -as'→* n'"
by(fastforce dest:silent_moves_preds_transfers_path)
from ‹S,kind ⊢ (n,s) =as'⇒⇩τ (n',transfers (kinds as) s)›
have "slice_edges S as' = []" by(fastforce dest:silent_moves_no_slice_edges)
with ‹n -as'→* n'› ‹valid_node n'› ‹n' ∈ S› obtain asx
where "n -asx→* n'" and "preds (slice_kinds S asx) s"
and "slice_edges S asx = []"
by -(erule exists_sliced_path_preds,auto intro:refl)
from ‹S,kind ⊢ (n,s) =as'⇒⇩τ (n',transfers (kinds as) s)›
‹((n,s),(n,s)) ∈ WS S› ‹obs n' (backward_slice S) = {n'}›
have "((n',transfers (kinds as) s),(n,s)) ∈ WS S"
by(fastforce intro:WS_silent_moves)
with True have "∀V ∈ rv S n'. state_val (transfers (kinds as) s) V =
state_val (transfers (slice_kinds S (slice_edges S as)) s) V"
by(fastforce dest:WSD simp:slice_edges_def slice_kinds_def)
with ‹∀V ∈ Use n'. V ∈ rv S n'›
have "∀V ∈ Use n'. state_val (transfers (kinds as) s) V =
state_val (transfers (slice_kinds S (slice_edges S as)) s) V" by simp
with ‹slice_edges S asx = []› ‹slice_edges S [] = slice_edges S as›
have "∀V ∈ Use n'. state_val (transfers (kinds as) s) V =
state_val (transfers (slice_kinds S (slice_edges S asx)) s) V"
by(simp add:slice_edges_def)
hence "∀V ∈ Use n'. state_val (transfers (kinds as) s) V =
state_val (transfers (slice_kinds S asx) s) V"
by(simp add:transfers_slice_kinds_slice_edges)
with ‹n -asx→* n'› ‹preds (slice_kinds S asx) s›
‹slice_edges S asx = []› ‹slice_edges S [] = slice_edges S as›
show ?thesis
by(rule_tac x="asx" in exI,simp add:slice_edges_def)
next
case False
with ‹S,kind ⊢ (n,s) =slice_edges S as⇒* (n'',s'')› ‹((n,s),(n,s)) ∈ WS S›
have "((n'',s''),(n'',transfers (slice_kinds S (slice_edges S as)) s)) ∈ WS S"
"S,slice_kind S ⊢ (n,s) =slice_edges S as⇒*
(n'',transfers (slice_kinds S (slice_edges S as)) s)"
by(fastforce dest:WS_weak_sim_trans)+
from ‹S,slice_kind S ⊢ (n,s) =slice_edges S as⇒*
(n'',transfers (slice_kinds S (slice_edges S as)) s)›
‹valid_node n›
obtain asx where "preds (slice_kinds S asx) s"
and "slice_edges S asx = slice_edges S as"
and "n -asx→* n''"
by(fastforce elim:trans_observable_moves_preds simp:slice_kinds_def)
from ‹n -asx→* n''› have "valid_node n''" by(fastforce dest:path_valid_node)
with ‹S,kind ⊢ (n'',s'') =as'⇒⇩τ (n',transfers (kinds as) s)›
have "n'' -as'→* n'"
by(fastforce dest:silent_moves_preds_transfers_path)
from ‹S,kind ⊢ (n'',s'') =as'⇒⇩τ (n',transfers (kinds as) s)›
have "slice_edges S as' = []" by(fastforce dest:silent_moves_no_slice_edges)
with ‹n'' -as'→* n'› ‹valid_node n'› ‹n' ∈ S› obtain asx'
where "n'' -asx'→* n'" and "slice_edges S asx' = []"
and "preds (slice_kinds S asx') (transfers (slice_kinds S asx) s)"
by -(erule exists_sliced_path_preds,auto intro:refl)
from ‹n -asx→* n''› ‹n'' -asx'→* n'› have "n -asx@asx'→* n'"
by(rule path_Append)
from ‹slice_edges S asx = slice_edges S as› ‹slice_edges S asx' = []›
have "slice_edges S as = slice_edges S (asx@asx')"
by(auto simp:slice_edges_def)
from ‹preds (slice_kinds S asx') (transfers (slice_kinds S asx) s)›
‹preds (slice_kinds S asx) s›
have "preds (slice_kinds S (asx@asx')) s"
by(simp add:slice_kinds_def preds_split)
from ‹obs n' (backward_slice S) = {n'}›
‹S,kind ⊢ (n'',s'') =as'⇒⇩τ (n',transfers (kinds as) s)›
‹((n'',s''),(n'',transfers (slice_kinds S (slice_edges S as)) s)) ∈ WS S›
have "((n',transfers (kinds as) s),
(n'',transfers (slice_kinds S (slice_edges S as)) s)) ∈ WS S"
by(fastforce intro:WS_silent_moves)
hence "∀V ∈ rv S n'. state_val (transfers (kinds as) s) V =
state_val (transfers (slice_kinds S (slice_edges S as)) s) V"
by(fastforce dest:WSD)
with ‹∀V ∈ Use n'. V ∈ rv S n'› ‹slice_edges S asx = slice_edges S as›
have "∀V ∈ Use n'. state_val (transfers (kinds as) s) V =
state_val (transfers (slice_kinds S (slice_edges S asx)) s) V"
by fastforce
with ‹slice_edges S asx' = []›
have "∀V ∈ Use n'. state_val (transfers (kinds as) s) V =
state_val (transfers (slice_kinds S (slice_edges S (asx@asx'))) s) V"
by(auto simp:slice_edges_def)
hence "∀V ∈ Use n'. state_val (transfers (kinds as) s) V =
state_val (transfers (slice_kinds S (asx@asx')) s) V"
by(simp add:transfers_slice_kinds_slice_edges)
with ‹preds (slice_kinds S (asx@asx')) s› ‹n -asx@asx'→* n'›
‹slice_edges S as = slice_edges S (asx@asx')›
show ?thesis by simp blast
qed
qed
end
subsection ‹The fundamental property of (static) slicing related to the semantics›
locale BackwardSlice_wf =
BackwardSlice sourcenode targetnode kind valid_edge Entry Def Use state_val
backward_slice +
CFG_semantics_wf sourcenode targetnode kind valid_edge Entry sem identifies
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val"
and backward_slice :: "'node set ⇒ 'node set"
and sem :: "'com ⇒ 'state ⇒ 'com ⇒ 'state ⇒ bool"
("((1⟨_,/_⟩) ⇒/ (1⟨_,/_⟩))" [0,0,0,0] 81)
and identifies :: "'node ⇒ 'com ⇒ bool" ("_ ≜ _" [51, 0] 80)
begin
theorem fundamental_property_of_path_slicing_semantically:
assumes "n ≜ c" and "⟨c,s⟩ ⇒ ⟨c',s'⟩"
obtains n' as where "n -as→* n'" and "preds (slice_kinds {n'} as) s" and "n' ≜ c'"
and "∀V ∈ Use n'. state_val (transfers (slice_kinds {n'} as) s) V = state_val s' V"
proof(atomize_elim)
from ‹n ≜ c› ‹⟨c,s⟩ ⇒ ⟨c',s'⟩› obtain n' as where "n -as→* n'"
and "transfers (kinds as) s = s'" and "preds (kinds as) s" and "n' ≜ c'"
by(fastforce dest:fundamental_property)
from ‹n -as→* n'› ‹preds (kinds as) s› obtain as'
where "preds (slice_kinds {n'} as') s"
and vals:"∀V ∈ Use n'. state_val (transfers (slice_kinds {n'} as') s) V =
state_val (transfers (kinds as) s) V" and "n -as'→* n'"
by -(erule fundamental_property_of_static_slicing,auto)
from ‹transfers (kinds as) s = s'› vals have "∀V ∈ Use n'.
state_val (transfers (slice_kinds {n'} as') s) V = state_val s' V"
by simp
with ‹preds (slice_kinds {n'} as') s› ‹n -as'→* n'› ‹ n' ≜ c'›
show "∃as n'. n -as→* n' ∧ preds (slice_kinds {n'} as) s ∧ n' ≜ c' ∧
(∀V∈Use n'. state_val (transfers (slice_kinds {n'} as) s) V = state_val s' V)"
by blast
qed
end
end
Theory StandardControlDependence
section ‹Static Standard Control Dependence›
theory StandardControlDependence imports
"../Basic/Postdomination"
"../Basic/DynStandardControlDependence"
begin
context Postdomination begin
subsubsection ‹Definition and some lemmas›
definition standard_control_dependence :: "'node ⇒ 'node ⇒ bool"
("_ controls⇩s _" [51,0])
where standard_control_dependences_eq:"n controls⇩s n' ≡ ∃as. n controls⇩s n' via as"
lemma standard_control_dependence_def:"n controls⇩s n' =
(∃a a' as. (n' ∉ set(sourcenodes (a#as))) ∧ (n -a#as→* n') ∧
(n' postdominates (targetnode a)) ∧
(valid_edge a') ∧ (sourcenode a' = n) ∧
(¬ n' postdominates (targetnode a')))"
by(auto simp:standard_control_dependences_eq dyn_standard_control_dependence_def)
lemma Exit_not_standard_control_dependent:
"n controls⇩s (_Exit_) ⟹ False"
by(auto simp:standard_control_dependences_eq
intro:Exit_not_dyn_standard_control_dependent)
lemma standard_control_dependence_def_variant:
"n controls⇩s n' = (∃as. (n -as→* n') ∧ (n ≠ n') ∧
(¬ n' postdominates n) ∧ (n' ∉ set(sourcenodes as)) ∧
(∀n'' ∈ set(targetnodes as). n' postdominates n''))"
by(auto simp:standard_control_dependences_eq
dyn_standard_control_dependence_def_variant)
lemma inner_node_standard_control_dependence_predecessor:
assumes "inner_node n" "(_Entry_) -as→* n" "n -as'→* (_Exit_)"
obtains n' where "n' controls⇩s n"
using assms
by(auto elim!:inner_node_dyn_standard_control_dependence_predecessor
simp:standard_control_dependences_eq)
end
end
Theory WeakControlDependence
section ‹Static Weak Control Dependence›
theory WeakControlDependence imports
"../Basic/Postdomination"
"../Basic/DynWeakControlDependence"
begin
context StrongPostdomination begin
definition
weak_control_dependence :: "'node ⇒ 'node ⇒ bool"
("_ weakly controls _" [51,0])
where weak_control_dependences_eq:
"n weakly controls n' ≡ ∃as. n weakly controls n' via as"
lemma
weak_control_dependence_def:"n weakly controls n' =
(∃a a' as. (n' ∉ set(sourcenodes (a#as))) ∧ (n -a#as→* n') ∧
(n' strongly-postdominates (targetnode a)) ∧
(valid_edge a') ∧ (sourcenode a' = n) ∧
(¬ n' strongly-postdominates (targetnode a')))"
by(auto simp:weak_control_dependences_eq dyn_weak_control_dependence_def)
lemma Exit_not_weak_control_dependent:
"n weakly controls (_Exit_) ⟹ False"
by(auto simp:weak_control_dependences_eq
intro:Exit_not_dyn_weak_control_dependent)
end
end
Theory PDG
section ‹Program Dependence Graph›
theory PDG imports
DataDependence
StandardControlDependence
WeakControlDependence
"../Basic/CFGExit_wf"
begin
locale PDG =
CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val"
and Exit :: "'node" ("'('_Exit'_')") +
fixes control_dependence :: "'node ⇒ 'node ⇒ bool"
("_ controls _ " [51,0])
assumes Exit_not_control_dependent:"n controls n' ⟹ n' ≠ (_Exit_)"
assumes control_dependence_path:
"n controls n'
⟹ ∃as. CFG.path sourcenode targetnode valid_edge n as n' ∧ as ≠ []"
begin
inductive cdep_edge :: "'node ⇒ 'node ⇒ bool"
("_ ⟶⇩c⇩d _" [51,0] 80)
and ddep_edge :: "'node ⇒ 'var ⇒ 'node ⇒ bool"
("_ -_→⇩d⇩d _" [51,0,0] 80)
and PDG_edge :: "'node ⇒ 'var option ⇒ 'node ⇒ bool"
where
"n ⟶⇩c⇩d n' == PDG_edge n None n'"
| "n -V→⇩d⇩d n' == PDG_edge n (Some V) n'"
| PDG_cdep_edge:
"n controls n' ⟹ n ⟶⇩c⇩d n'"
| PDG_ddep_edge:
"n influences V in n' ⟹ n -V→⇩d⇩d n'"
inductive PDG_path :: "'node ⇒ 'node ⇒ bool"
("_ ⟶⇩d* _" [51,0] 80)
where PDG_path_Nil:
"valid_node n ⟹ n ⟶⇩d* n"
| PDG_path_Append_cdep:
"⟦n ⟶⇩d* n''; n'' ⟶⇩c⇩d n'⟧ ⟹ n ⟶⇩d* n'"
| PDG_path_Append_ddep:
"⟦n ⟶⇩d* n''; n'' -V→⇩d⇩d n'⟧ ⟹ n ⟶⇩d* n'"
lemma PDG_path_cdep:"n ⟶⇩c⇩d n' ⟹ n ⟶⇩d* n'"
apply -
apply(rule PDG_path_Append_cdep, rule PDG_path_Nil)
by(auto elim!:PDG_edge.cases dest:control_dependence_path path_valid_node)
lemma PDG_path_ddep:"n -V→⇩d⇩d n' ⟹ n ⟶⇩d* n'"
apply -
apply(rule PDG_path_Append_ddep, rule PDG_path_Nil)
by(auto elim!:PDG_edge.cases dest:path_valid_node simp:data_dependence_def)
lemma PDG_path_Append:
"⟦n'' ⟶⇩d* n'; n ⟶⇩d* n''⟧ ⟹ n ⟶⇩d* n'"
by(induct rule:PDG_path.induct,auto intro:PDG_path.intros)
lemma PDG_cdep_edge_CFG_path:
assumes "n ⟶⇩c⇩d n'" obtains as where "n -as→* n'" and "as ≠ []"
using ‹n ⟶⇩c⇩d n'›
by(auto elim:PDG_edge.cases dest:control_dependence_path)
lemma PDG_ddep_edge_CFG_path:
assumes "n -V→⇩d⇩d n'" obtains as where "n -as→* n'" and "as ≠ []"
using ‹n -V→⇩d⇩d n'›
by(auto elim!:PDG_edge.cases simp:data_dependence_def)
lemma PDG_path_CFG_path:
assumes "n ⟶⇩d* n'" obtains as where "n -as→* n'"
proof(atomize_elim)
from ‹n ⟶⇩d* n'› show "∃as. n -as→* n'"
proof(induct rule:PDG_path.induct)
case (PDG_path_Nil n)
hence "n -[]→* n" by(rule empty_path)
thus ?case by blast
next
case (PDG_path_Append_cdep n n'' n')
from ‹n'' ⟶⇩c⇩d n'› obtain as where "n'' -as→* n'"
by(fastforce elim:PDG_cdep_edge_CFG_path)
with ‹∃as. n -as→* n''› obtain as' where "n -as'@as→* n'"
by(auto dest:path_Append)
thus ?case by blast
next
case (PDG_path_Append_ddep n n'' V n')
from ‹n'' -V→⇩d⇩d n'› obtain as where "n'' -as→* n'"
by(fastforce elim:PDG_ddep_edge_CFG_path)
with ‹∃as. n -as→* n''› obtain as' where "n -as'@as→* n'"
by(auto dest:path_Append)
thus ?case by blast
qed
qed
lemma PDG_path_Exit:"⟦n ⟶⇩d* n'; n' = (_Exit_)⟧ ⟹ n = (_Exit_)"
apply(induct rule:PDG_path.induct)
by(auto elim:PDG_edge.cases dest:Exit_not_control_dependent
simp:data_dependence_def)
lemma PDG_path_not_inner:
"⟦n ⟶⇩d* n'; ¬ inner_node n'⟧ ⟹ n = n'"
proof(induct rule:PDG_path.induct)
case (PDG_path_Nil n)
thus ?case by simp
next
case (PDG_path_Append_cdep n n'' n')
from ‹n'' ⟶⇩c⇩d n'› ‹¬ inner_node n'› have False
apply -
apply(erule PDG_edge.cases) apply(auto simp:inner_node_def)
apply(fastforce dest:control_dependence_path path_valid_node)
apply(fastforce dest:control_dependence_path path_valid_node)
by(fastforce dest:Exit_not_control_dependent)
thus ?case by simp
next
case (PDG_path_Append_ddep n n'' V n')
from ‹n'' -V→⇩d⇩d n'› ‹¬ inner_node n'› have False
apply -
apply(erule PDG_edge.cases)
by(auto dest:path_valid_node simp:inner_node_def data_dependence_def)
thus ?case by simp
qed
subsection ‹Definition of the static backward slice›
text ‹Node: instead of a single node, we calculate the backward slice of a set
of nodes.›
definition PDG_BS :: "'node set ⇒ 'node set"
where "PDG_BS S ≡ {n'. ∃n. n' ⟶⇩d* n ∧ n ∈ S ∧ valid_node n}"
lemma PDG_BS_valid_node:"n ∈ PDG_BS S ⟹ valid_node n"
by(auto elim:PDG_path_CFG_path dest:path_valid_node simp:PDG_BS_def
split:if_split_asm)
lemma Exit_PDG_BS:"n ∈ PDG_BS {(_Exit_)} ⟹ n = (_Exit_)"
by(fastforce dest:PDG_path_Exit simp:PDG_BS_def)
end
subsection ‹Instantiate static PDG›
subsubsection ‹Standard control dependence›
locale StandardControlDependencePDG =
Postdomination sourcenode targetnode kind valid_edge Entry Exit +
CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val"
and Exit :: "'node" ("'('_Exit'_')")
begin
lemma PDG_scd:
"PDG sourcenode targetnode kind valid_edge (_Entry_)
Def Use state_val (_Exit_) standard_control_dependence"
proof(unfold_locales)
fix n n' assume "n controls⇩s n'"
show "n' ≠ (_Exit_)"
proof
assume "n' = (_Exit_)"
with ‹n controls⇩s n'› show False
by(fastforce intro:Exit_not_standard_control_dependent)
qed
next
fix n n' assume "n controls⇩s n'"
thus "∃as. n -as→* n' ∧ as ≠ []"
by(fastforce simp:standard_control_dependence_def)
qed
lemmas PDG_cdep_edge = PDG.PDG_cdep_edge[OF PDG_scd]
lemmas PDG_path_Nil = PDG.PDG_path_Nil[OF PDG_scd]
lemmas PDG_path_Append = PDG.PDG_path_Append[OF PDG_scd]
lemmas PDG_path_CFG_path = PDG.PDG_path_CFG_path[OF PDG_scd]
lemmas PDG_path_cdep = PDG.PDG_path_cdep[OF PDG_scd]
lemmas PDG_path_ddep = PDG.PDG_path_ddep[OF PDG_scd]
lemmas PDG_path_not_inner = PDG.PDG_path_not_inner[OF PDG_scd]
lemmas PDG_path_Exit = PDG.PDG_path_Exit[OF PDG_scd]
definition PDG_BS_s :: "'node set ⇒ 'node set" ("PDG'_BS")
where "PDG_BS S ≡
PDG.PDG_BS sourcenode targetnode valid_edge Def Use standard_control_dependence S"
lemma [simp]: "PDG.PDG_BS sourcenode targetnode valid_edge Def Use
standard_control_dependence S = PDG_BS S"
by(simp add:PDG_BS_s_def)
lemmas PDG_BS_def = PDG.PDG_BS_def[OF PDG_scd,simplified]
lemmas PDG_BS_valid_node = PDG.PDG_BS_valid_node[OF PDG_scd,simplified]
lemmas Exit_PDG_BS = PDG.Exit_PDG_BS[OF PDG_scd,simplified]
end
subsubsection ‹Weak control dependence›
locale WeakControlDependencePDG =
StrongPostdomination sourcenode targetnode kind valid_edge Entry Exit +
CFGExit_wf sourcenode targetnode kind valid_edge Entry Def Use state_val Exit
for sourcenode :: "'edge ⇒ 'node" and targetnode :: "'edge ⇒ 'node"
and kind :: "'edge ⇒ 'state edge_kind" and valid_edge :: "'edge ⇒ bool"
and Entry :: "'node" ("'('_Entry'_')") and Def :: "'node ⇒ 'var set"
and Use :: "'node ⇒ 'var set" and state_val :: "'state ⇒ 'var ⇒ 'val"
and Exit :: "'node" ("'('_Exit'_')")
begin
lemma PDG_wcd:
"PDG sourcenode targetnode kind valid_edge (_Entry_)
Def Use state_val (_Exit_) weak_control_dependence"
proof(unfold_locales)
fix n n' assume "n weakly controls n'"
show "n' ≠ (_Exit_)"
proof
assume "n' = (_Exit_)"
with ‹n weakly controls n'› show False
by(fastforce intro:Exit_not_weak_control_dependent)
qed
next
fix n n' assume "n weakly controls n'"
thus "∃as. n -as→* n' ∧ as ≠ []"
by(fastforce simp:weak_control_dependence_def)
qed
lemmas PDG_cdep_edge = PDG.PDG_cdep_edge[OF PDG_wcd]
lemmas PDG_path_Nil = PDG.PDG_path_Nil[OF PDG_wcd]
lemmas PDG_path_Append = PDG.PDG_path_Append[OF PDG_wcd]
lemmas PDG_path_CFG_path = PDG.PDG_path_CFG_path[OF PDG_wcd]
lemmas PDG_path_cdep = PDG.PDG_path_cdep[OF PDG_wcd]
lemmas PDG_path_ddep = PDG.PDG_path_ddep[OF PDG_wcd]
lemmas PDG_path_not_inner = PDG.PDG_path_not_inner[OF PDG_wcd]
lemmas PDG_path_Exit = PDG.PDG_path_Exit[OF PDG_wcd]
definition PDG_BS_w :: "'node set ⇒ 'node set" ("PDG'_BS")
where "PDG_BS S ≡
PDG.PDG_BS sourcenode targetnode valid_edge Def Use weak_control_dependence S"
lemma [simp]: "PDG.PDG_BS sourcenode targetnode valid_edge Def Use
weak_control_dependence S = PDG_BS S"
by(simp add:PDG_BS_w_def)
lemmas PDG_BS_def = PDG.PDG_BS_def[OF PDG_wcd,simplified]
lemmas PDG_BS_valid_node = PDG.PDG_BS_valid_node[OF PDG_wcd,simplified]
lemmas Exit_PDG_BS = PDG.Exit_PDG_BS[OF PDG_wcd,simplified]
end
end
Theory WeakOrderDependence
section ‹Weak Order Dependence›
theory WeakOrderDependence imports "../Basic/CFG" DataDependence begin
text ‹Weak order dependence is just defined as a static control dependence›
subsection‹Definition and some lemmas›
definition (in CFG) weak_order_dependence :: "'node ⇒ 'node ⇒ 'node ⇒ bool"
("_ ⟶⇩w⇩o⇩d _,_")
where wod_def:"n ⟶⇩w⇩o⇩d n⇩1,n⇩2 ≡ ((n⇩1 ≠ n⇩2) ∧
(∃as. (n -as→* n⇩1) ∧ (n⇩2 ∉ set (sourcenodes as))) ∧
(∃as. (n -as→* n⇩2) ∧ (n⇩1 ∉ set (sourcenodes as))) ∧
(∃a. (valid_edge a) ∧ (n = sourcenode a) ∧
((∃as. (targetnode a -as→* n⇩1) ∧
(∀as'. (targetnode a -as'→* n⇩2) ⟶ n⇩1 ∈ set(sourcenodes as'))) ∨
(∃as. (targetnode a -as→* n⇩2) ∧
(∀as'. (targetnode a -as'→* n⇩1) ⟶ n⇩2 ∈ set(sourcenodes as'))))))"
inductive_set (in CFG_wf) wod_backward_slice :: "'node set ⇒ 'node set"
for S :: "'node set"
where refl:"⟦valid_node n; n ∈ S⟧ ⟹ n ∈ wod_backward_slice S"
| cd_closed:
"⟦n' ⟶⇩w⇩o⇩d n⇩1,n⇩2; n⇩1 ∈ wod_backward_slice S; n⇩2 ∈ wod_backward_slice S⟧
⟹ n' ∈ wod_backward_slice S"
| dd_closed:"⟦n' influences V in n''; n'' ∈ wod_backward_slice S⟧
⟹ n' ∈ wod_backward_slice S"
lemma (in CFG_wf)
wod_backward_slice_valid_node:"n ∈ wod_backward_slice S ⟹ valid_node n"
by(induct rule:wod_backward_slice.induct,
auto dest:path_valid_node simp:wod_def data_dependence_def)
end
Theory CDepInstantiations
section ‹Instantiate framework with control dependences›
theory CDepInstantiations imports
Slice
PDG
WeakOrderDependence
begin
subsection‹Standard control dependence›
context StandardControlDependencePDG begin
lemma Exit_in_obs_slice_node:"(_Exit_) ∈ obs n' (PDG_BS S) ⟹ (_Exit_) ∈ S"
by(auto elim:obsE PDG_path_CFG_path simp:PDG_BS_def split:if_split_asm)
abbreviation PDG_path' :: "'node ⇒ 'node ⇒ bool" ("_ ⟶⇩d* _" [51,0] 80)
where "n ⟶⇩d* n' ≡ PDG.PDG_path sourcenode targetnode valid_edge Def Use
standard_control_dependence n n'"
lemma cd_closed:
"⟦n' ∈ PDG_BS S; n controls⇩s n'⟧ ⟹ n ∈ PDG_BS S"
by(simp add:PDG_BS_def)(blast dest:PDG_cdep_edge PDG_path_Append PDG_path_cdep)
lemma obs_postdominate:
assumes "n ∈ obs n' (PDG_BS S)" and "n ≠ (_Exit_)" shows "n postdominates n'"
proof(rule ccontr)
assume "¬ n postdominates n'"
from ‹n ∈ obs n' (PDG_BS S)› have "valid_node n" by(fastforce dest:in_obs_valid)
with ‹n ∈ obs n' (PDG_BS S)› ‹n ≠ (_Exit_)› have "n postdominates n"
by(fastforce intro:postdominate_refl)
from ‹n ∈ obs n' (PDG_BS S)› obtain as where "n' -as→* n"
and "∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)"
and "n ∈ (PDG_BS S)" by(erule obsE)
from ‹n postdominates n› ‹¬ n postdominates n'› ‹n' -as→* n›
obtain as' a as'' where [simp]:"as = as'@a#as''" and "valid_edge a"
and "¬ n postdominates (sourcenode a)" and "n postdominates (targetnode a)"
by -(erule postdominate_path_branch)
from ‹¬ n postdominates (sourcenode a)› ‹valid_edge a› ‹valid_node n›
obtain asx where "sourcenode a -asx→* (_Exit_)"
and "n ∉ set(sourcenodes asx)" by(auto simp:postdominate_def)
from ‹sourcenode a -asx→* (_Exit_)› ‹valid_edge a›
obtain ax asx' where [simp]:"asx = ax#asx'"
apply - apply(erule path.cases)
apply(drule_tac s="(_Exit_)" in sym)
apply simp
apply(drule Exit_source)
by simp_all
with ‹sourcenode a -asx→* (_Exit_)› have "sourcenode a -[]@ax#asx'→* (_Exit_)"
by simp
hence "valid_edge ax" and [simp]:"sourcenode a = sourcenode ax"
and "targetnode ax -asx'→* (_Exit_)"
by(fastforce dest:path_split)+
with ‹n ∉ set(sourcenodes asx)› have "¬ n postdominates targetnode ax"
by(fastforce simp:postdominate_def sourcenodes_def)
from ‹n ∈ obs n' (PDG_BS S)› ‹∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)›
have "n ∉ set (sourcenodes (a#as''))"
by(fastforce elim:obs.cases simp:sourcenodes_def)
from ‹n' -as→* n› have "sourcenode a -a#as''→* n"
by(fastforce dest:path_split_second)
with ‹n postdominates (targetnode a)› ‹¬ n postdominates targetnode ax›
‹valid_edge ax› ‹n ∉ set (sourcenodes (a#as''))›
have "sourcenode a controls⇩s n" by(fastforce simp:standard_control_dependence_def)
with ‹n ∈ obs n' (PDG_BS S)› have "sourcenode a ∈ (PDG_BS S)"
by(fastforce intro:cd_closed PDG_cdep_edge elim:obs.cases)
with ‹∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)›
show False by(simp add:sourcenodes_def)
qed
lemma obs_singleton:"(∃m. obs n (PDG_BS S) = {m}) ∨ obs n (PDG_BS S) = {}"
proof(rule ccontr)
assume "¬ ((∃m. obs n (PDG_BS S) = {m}) ∨ obs n (PDG_BS S) = {})"
hence "∃nx nx'. nx ∈ obs n (PDG_BS S) ∧ nx' ∈ obs n (PDG_BS S) ∧
nx ≠ nx'" by auto
then obtain nx nx' where "nx ∈ obs n (PDG_BS S)" and "nx' ∈ obs n (PDG_BS S)"
and "nx ≠ nx'" by auto
from ‹nx ∈ obs n (PDG_BS S)› obtain as where "n -as→* nx"
and "∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)" and "nx ∈ (PDG_BS S)"
by(erule obsE)
from ‹n -as→* nx› have "valid_node nx" by(fastforce dest:path_valid_node)
with ‹nx ∈ (PDG_BS S)› have "obs nx (PDG_BS S) = {nx}" by -(rule n_in_obs)
with ‹n -as→* nx› ‹nx ∈ obs n (PDG_BS S)› ‹nx' ∈ obs n (PDG_BS S)› ‹nx ≠ nx'›
have "as ≠ []" by(fastforce elim:path.cases)
with ‹n -as→* nx› ‹nx ∈ obs n (PDG_BS S)› ‹nx' ∈ obs n (PDG_BS S)›
‹nx ≠ nx'› ‹obs nx (PDG_BS S) = {nx}› ‹∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)›
have "∃a as' as''. n -as'→* sourcenode a ∧ targetnode a -as''→* nx ∧
valid_edge a ∧ as = as'@a#as'' ∧
obs (targetnode a) (PDG_BS S) = {nx} ∧
(¬ (∃m. obs (sourcenode a) (PDG_BS S) = {m} ∨
obs (sourcenode a) (PDG_BS S) = {}))"
proof(induct arbitrary:nx' rule:path.induct)
case (Cons_path n'' as n' a n)
note [simp] = ‹sourcenode a = n›[THEN sym] ‹targetnode a = n''›[THEN sym]
note more_than_one = ‹n' ∈ obs n (PDG_BS S)› ‹nx' ∈ obs n (PDG_BS S)› ‹n' ≠ nx'›
note IH = ‹⋀nx'. ⟦n' ∈ obs n'' (PDG_BS S); nx' ∈ obs n'' (PDG_BS S); n' ≠ nx';
obs n' (PDG_BS S) = {n'}; ∀n'∈set (sourcenodes as). n' ∉ (PDG_BS S); as ≠ []⟧
⟹ ∃a as' as''. n'' -as'→* sourcenode a ∧ targetnode a -as''→* n' ∧
valid_edge a ∧ as = as'@a#as'' ∧ obs (targetnode a) (PDG_BS S) = {n'} ∧
(¬ (∃m. obs (sourcenode a) (PDG_BS S) = {m} ∨
obs (sourcenode a) (PDG_BS S) = {}))›
from ‹∀n'∈set (sourcenodes (a#as)). n' ∉ (PDG_BS S)›
have "∀n'∈set (sourcenodes as). n' ∉ (PDG_BS S)" and "sourcenode a ∉ (PDG_BS S)"
by(simp_all add:sourcenodes_def)
show ?case
proof(cases "as = []")
case True
with ‹n'' -as→* n'› have [simp]:"n' = n''" by(fastforce elim:path.cases)
from more_than_one
have "¬ (∃m. obs (sourcenode a) (PDG_BS S) = {m} ∨
obs (sourcenode a) (PDG_BS S) = {})"
by auto
with ‹obs n' (PDG_BS S) = {n'}› True ‹valid_edge a› show ?thesis
apply(rule_tac x="a" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="[]" in exI)
by(auto intro!:empty_path)
next
case False
hence "as ≠ []" .
from ‹n'' -as→* n'› ‹∀n'∈set (sourcenodes as). n' ∉ (PDG_BS S)›
have "obs n' (PDG_BS S) ⊆ obs n'' (PDG_BS S)" by(rule path_obs_subset)
show ?thesis
proof(cases "obs n' (PDG_BS S) = obs n'' (PDG_BS S)")
case True
with ‹n'' -as→* n'› ‹valid_edge a› ‹obs n' (PDG_BS S) = {n'}› more_than_one
show ?thesis
apply(rule_tac x="a" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="as" in exI)
by(fastforce intro:empty_path)
next
case False
with ‹obs n' (PDG_BS S) ⊆ obs n'' (PDG_BS S)›
have "obs n' (PDG_BS S) ⊂ obs n'' (PDG_BS S)" by simp
with ‹obs n' (PDG_BS S) = {n'}› obtain ni where "n' ∈ obs n'' (PDG_BS S)"
and "ni ∈ obs n'' (PDG_BS S)" and "n' ≠ ni" by auto
from IH[OF this ‹obs n' (PDG_BS S) = {n'}›
‹∀n'∈set (sourcenodes as). n' ∉ (PDG_BS S)› ‹as ≠ []›] obtain a' as' as''
where "n'' -as'→* sourcenode a'" and "targetnode a' -as''→* n'"
and "valid_edge a'" and [simp]:"as = as'@a'#as''"
and "obs (targetnode a') (PDG_BS S) = {n'}"
and more_than_one':"¬ (∃m. obs (sourcenode a') (PDG_BS S) = {m} ∨
obs (sourcenode a') (PDG_BS S) = {})"
by blast
from ‹n'' -as'→* sourcenode a'› ‹valid_edge a›
have "n -a#as'→* sourcenode a'" by(fastforce intro:path.Cons_path)
with ‹targetnode a' -as''→* n'› ‹obs (targetnode a') (PDG_BS S) = {n'}›
more_than_one' ‹valid_edge a'› show ?thesis
apply(rule_tac x="a'" in exI)
apply(rule_tac x="a#as'" in exI)
apply(rule_tac x="as''" in exI)
by fastforce
qed
qed
qed simp
then obtain a as' as'' where "valid_edge a"
and "obs (targetnode a) (PDG_BS S) = {nx}"
and more_than_one:"¬ (∃m. obs (sourcenode a) (PDG_BS S) = {m} ∨
obs (sourcenode a) (PDG_BS S) = {})"
by blast
have "sourcenode a ∉ (PDG_BS S)"
proof(rule ccontr)
assume "¬ sourcenode a ∉ PDG_BS S"
hence "sourcenode a ∈ PDG_BS S" by simp
with ‹valid_edge a› have "obs (sourcenode a) (PDG_BS S) = {sourcenode a}"
by(fastforce intro!:n_in_obs)
with more_than_one show False by simp
qed
with ‹valid_edge a›
have "obs (targetnode a) (PDG_BS S) ⊆ obs (sourcenode a) (PDG_BS S)"
by(rule edge_obs_subset)
with ‹obs (targetnode a) (PDG_BS S) = {nx}›
have "nx ∈ obs (sourcenode a) (PDG_BS S)" by simp
with more_than_one obtain m where "m ∈ obs (sourcenode a) (PDG_BS S)"
and "nx ≠ m" by auto
from ‹m ∈ obs (sourcenode a) (PDG_BS S)›
have "valid_node m" by(fastforce dest:in_obs_valid)
from ‹obs (targetnode a) (PDG_BS S) = {nx}› have "valid_node nx"
by(fastforce dest:in_obs_valid)
show False
proof(cases "m postdominates (sourcenode a)")
case True
with ‹nx ∈ obs (sourcenode a) (PDG_BS S)› ‹m ∈ obs (sourcenode a) (PDG_BS S)›
have "m postdominates nx"
by(fastforce intro:postdominate_path_targetnode elim:obs.cases)
with ‹nx ≠ m› have "¬ nx postdominates m" by(fastforce dest:postdominate_antisym)
have "(_Exit_) -[]→* (_Exit_)" by(fastforce intro:empty_path)
with ‹m postdominates nx› have "nx ≠ (_Exit_)"
by(fastforce simp:postdominate_def sourcenodes_def)
have "¬ nx postdominates (sourcenode a)"
proof(rule ccontr)
assume "¬ ¬ nx postdominates sourcenode a"
hence "nx postdominates sourcenode a" by simp
from ‹m ∈ obs (sourcenode a) (PDG_BS S)› ‹nx ∈ obs (sourcenode a) (PDG_BS S)›
obtain asx' where "sourcenode a -asx'→* m" and "nx ∉ set(sourcenodes asx')"
by(fastforce elim:obs.cases)
with ‹nx postdominates sourcenode a› have "nx postdominates m"
by(rule postdominate_path_targetnode)
with ‹¬ nx postdominates m› show False by simp
qed
with ‹nx ∈ obs (sourcenode a) (PDG_BS S)› ‹valid_node nx› ‹nx ≠ (_Exit_)›
show False by(fastforce dest:obs_postdominate)
next
case False
show False
proof(cases "m = Exit")
case True
from ‹m ∈ obs (sourcenode a) (PDG_BS S)› ‹nx ∈ obs (sourcenode a) (PDG_BS S)›
obtain xs where "sourcenode a -xs→* m" and "nx ∉ set(sourcenodes xs)"
by(fastforce elim:obsE)
obtain x' xs' where [simp]:"xs = x'#xs'"
proof(cases xs)
case Nil
with ‹sourcenode a -xs→* m› have [simp]:"sourcenode a = m" by fastforce
with ‹m ∈ obs (sourcenode a) (PDG_BS S)›
have "m ∈ (PDG_BS S)" by(metis obsE)
with ‹valid_node m› have "obs m (PDG_BS S) = {m}"
by(rule n_in_obs)
with ‹nx ∈ obs (sourcenode a) (PDG_BS S)› ‹nx ≠ m› have False
by fastforce
thus ?thesis by simp
qed blast
from ‹sourcenode a -xs→* m› have "sourcenode a = sourcenode x'"
and "valid_edge x'" and "targetnode x' -xs'→* m"
by(auto elim:path_split_Cons)
from ‹targetnode x' -xs'→* m› ‹nx ∉ set(sourcenodes xs)› ‹valid_edge x'›
‹valid_node m› True
have "¬ nx postdominates (targetnode x')"
by(fastforce simp:postdominate_def sourcenodes_def)
from ‹nx ≠ m› True have "nx ≠ (_Exit_)" by simp
with ‹obs (targetnode a) (PDG_BS S) = {nx}›
have "nx postdominates (targetnode a)"
by(fastforce intro:obs_postdominate)
from ‹obs (targetnode a) (PDG_BS S) = {nx}›
obtain ys where "targetnode a -ys→* nx"
and "∀nx' ∈ set(sourcenodes ys). nx' ∉ (PDG_BS S)"
and "nx ∈ (PDG_BS S)" by(fastforce elim:obsE)
hence "nx ∉ set(sourcenodes ys)"by fastforce
have "sourcenode a ≠ nx"
proof
assume "sourcenode a = nx"
from ‹nx ∈ obs (sourcenode a) (PDG_BS S)›
have "nx ∈ (PDG_BS S)" by -(erule obsE)
with ‹valid_node nx› have "obs nx (PDG_BS S) = {nx}" by -(erule n_in_obs)
with ‹sourcenode a = nx› ‹m ∈ obs (sourcenode a) (PDG_BS S)›
‹nx ≠ m› show False by fastforce
qed
with ‹nx ∉ set(sourcenodes ys)› have "nx ∉ set(sourcenodes (a#ys))"
by(fastforce simp:sourcenodes_def)
from ‹valid_edge a› ‹targetnode a -ys→* nx›
have "sourcenode a -a#ys→* nx" by(fastforce intro:Cons_path)
from ‹sourcenode a -a#ys→* nx› ‹nx ∉ set(sourcenodes (a#ys))›
‹nx postdominates (targetnode a)› ‹valid_edge x'›
‹¬ nx postdominates (targetnode x')› ‹sourcenode a = sourcenode x'›
have "(sourcenode a) controls⇩s nx"
by(fastforce simp:standard_control_dependence_def)
with ‹nx ∈ (PDG_BS S)› have "sourcenode a ∈ (PDG_BS S)"
by(rule cd_closed)
with ‹valid_edge a› have "obs (sourcenode a) (PDG_BS S) = {sourcenode a}"
by(fastforce intro!:n_in_obs)
with ‹m ∈ obs (sourcenode a) (PDG_BS S)›
‹nx ∈ obs (sourcenode a) (PDG_BS S)› ‹nx ≠ m›
show False by simp
next
case False
with ‹m ∈ obs (sourcenode a) (PDG_BS S)› ‹valid_node m›
‹¬ m postdominates sourcenode a›
show False by(fastforce dest:obs_postdominate)
qed
qed
qed
lemma PDGBackwardSliceCorrect:
"BackwardSlice sourcenode targetnode kind valid_edge
(_Entry_) Def Use state_val PDG_BS"
proof(unfold_locales)
fix n S assume "n ∈ PDG_BS S"
thus "valid_node n" by(rule PDG_BS_valid_node)
next
fix n S assume "valid_node n" and "n ∈ S"
thus "n ∈ PDG_BS S" by(fastforce intro:PDG_path_Nil simp:PDG_BS_def)
next
fix n' S n V
assume "n' ∈ PDG_BS S" and "n influences V in n'"
thus "n ∈ PDG_BS S"
by(auto dest:PDG.PDG_path_ddep[OF PDG_scd,OF PDG.PDG_ddep_edge[OF PDG_scd]]
dest:PDG_path_Append simp:PDG_BS_def split:if_split_asm)
next
fix n S
have "(∃m. obs n (PDG_BS S) = {m}) ∨ obs n (PDG_BS S) = {}"
by(rule obs_singleton)
thus "finite (obs n (PDG_BS S))" by fastforce
next
fix n S
have "(∃m. obs n (PDG_BS S) = {m}) ∨ obs n (PDG_BS S) = {}"
by(rule obs_singleton)
thus "card (obs n (PDG_BS S)) ≤ 1" by fastforce
qed
end
subsection‹Weak control dependence›
context WeakControlDependencePDG begin
lemma Exit_in_obs_slice_node:"(_Exit_) ∈ obs n' (PDG_BS S) ⟹ (_Exit_) ∈ S"
by(auto elim:obsE PDG_path_CFG_path simp:PDG_BS_def split:if_split_asm)
lemma cd_closed:
"⟦n' ∈ PDG_BS S; n weakly controls n'⟧ ⟹ n ∈ PDG_BS S"
by(simp add:PDG_BS_def)(blast dest:PDG_cdep_edge PDG_path_Append PDG_path_cdep)
lemma obs_strong_postdominate:
assumes "n ∈ obs n' (PDG_BS S)" and "n ≠ (_Exit_)"
shows "n strongly-postdominates n'"
proof(rule ccontr)
assume "¬ n strongly-postdominates n'"
from ‹n ∈ obs n' (PDG_BS S)› have "valid_node n" by(fastforce dest:in_obs_valid)
with ‹n ∈ obs n' (PDG_BS S)› ‹n ≠ (_Exit_)› have "n strongly-postdominates n"
by(fastforce intro:strong_postdominate_refl)
from ‹n ∈ obs n' (PDG_BS S)› obtain as where "n' -as→* n"
and "∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)"
and "n ∈ (PDG_BS S)" by(erule obsE)
from ‹n strongly-postdominates n› ‹¬ n strongly-postdominates n'› ‹n' -as→* n›
obtain as' a as'' where [simp]:"as = as'@a#as''" and "valid_edge a"
and "¬ n strongly-postdominates (sourcenode a)" and
"n strongly-postdominates (targetnode a)"
by -(erule strong_postdominate_path_branch)
from ‹n ∈ obs n' (PDG_BS S)› ‹∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)›
have "n ∉ set (sourcenodes (a#as''))"
by(fastforce elim:obs.cases simp:sourcenodes_def)
from ‹n' -as→* n› have "sourcenode a -a#as''→* n"
by(fastforce dest:path_split_second)
from ‹¬ n strongly-postdominates (sourcenode a)› ‹valid_edge a› ‹valid_node n›
obtain a' where "sourcenode a' = sourcenode a"
and "valid_edge a'" and "¬ n strongly-postdominates (targetnode a')"
by(fastforce elim:not_strong_postdominate_predecessor_successor)
with ‹n strongly-postdominates (targetnode a)› ‹n ∉ set (sourcenodes (a#as''))›
‹sourcenode a -a#as''→* n›
have "sourcenode a weakly controls n"
by(fastforce simp:weak_control_dependence_def)
with ‹n ∈ obs n' (PDG_BS S)› have "sourcenode a ∈ (PDG_BS S)"
by(fastforce intro:cd_closed PDG_cdep_edge elim:obs.cases)
with ‹∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)›
show False by(simp add:sourcenodes_def)
qed
lemma obs_singleton:"(∃m. obs n (PDG_BS S) = {m}) ∨ obs n (PDG_BS S) = {}"
proof(rule ccontr)
assume "¬ ((∃m. obs n (PDG_BS S) = {m}) ∨ obs n (PDG_BS S) = {})"
hence "∃nx nx'. nx ∈ obs n (PDG_BS S) ∧ nx' ∈ obs n (PDG_BS S) ∧
nx ≠ nx'" by auto
then obtain nx nx' where "nx ∈ obs n (PDG_BS S)" and "nx' ∈ obs n (PDG_BS S)"
and "nx ≠ nx'" by auto
from ‹nx ∈ obs n (PDG_BS S)› obtain as where "n -as→* nx"
and "∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)" and "nx ∈ (PDG_BS S)"
by(erule obsE)
from ‹n -as→* nx› have "valid_node nx" by(fastforce dest:path_valid_node)
with ‹nx ∈ (PDG_BS S)› have "obs nx (PDG_BS S) = {nx}" by -(rule n_in_obs)
with ‹n -as→* nx› ‹nx ∈ obs n (PDG_BS S)› ‹nx' ∈ obs n (PDG_BS S)› ‹nx ≠ nx'›
have "as ≠ []" by(fastforce elim:path.cases)
with ‹n -as→* nx› ‹nx ∈ obs n (PDG_BS S)› ‹nx' ∈ obs n (PDG_BS S)›
‹nx ≠ nx'› ‹obs nx (PDG_BS S) = {nx}› ‹∀n' ∈ set(sourcenodes as). n' ∉ (PDG_BS S)›
have "∃a as' as''. n -as'→* sourcenode a ∧ targetnode a -as''→* nx ∧
valid_edge a ∧ as = as'@a#as'' ∧
obs (targetnode a) (PDG_BS S) = {nx} ∧
(¬ (∃m. obs (sourcenode a) (PDG_BS S) = {m} ∨
obs (sourcenode a) (PDG_BS S) = {}))"
proof(induct arbitrary:nx' rule:path.induct)
case (Cons_path n'' as n' a n)
note [simp] = ‹sourcenode a = n›[THEN sym] ‹targetnode a = n''›[THEN sym]
note more_than_one = ‹n' ∈ obs n (PDG_BS S)› ‹nx' ∈ obs n (PDG_BS S)› ‹n' ≠ nx'›
note IH = ‹⋀nx'. ⟦n' ∈ obs n'' (PDG_BS S); nx' ∈ obs n'' (PDG_BS S); n' ≠ nx';
obs n' (PDG_BS S) = {n'}; ∀n'∈set (sourcenodes as). n' ∉ (PDG_BS S); as ≠ []⟧
⟹ ∃a as' as''. n'' -as'→* sourcenode a ∧ targetnode a -as''→* n' ∧
valid_edge a ∧ as = as'@a#as'' ∧ obs (targetnode a) (PDG_BS S) = {n'} ∧
(¬ (∃m. obs (sourcenode a) (PDG_BS S) = {m} ∨
obs (sourcenode a) (PDG_BS S) = {}))›
from ‹∀n'∈set (sourcenodes (a#as)). n' ∉ (PDG_BS S)›
have "∀n'∈set (sourcenodes as). n' ∉ (PDG_BS S)" and "sourcenode a ∉ (PDG_BS S)"
by(simp_all add:sourcenodes_def)
show ?case
proof(cases "as = []")
case True
with ‹n'' -as→* n'› have [simp]:"n' = n''" by(fastforce elim:path.cases)
from more_than_one
have "¬ (∃m. obs (sourcenode a) (PDG_BS S) = {m} ∨
obs (sourcenode a) (PDG_BS S) = {})"
by auto
with ‹obs n' (PDG_BS S) = {n'}› True ‹valid_edge a› show ?thesis
apply(rule_tac x="a" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="[]" in exI)
by(auto intro!:empty_path)
next
case False
hence "as ≠ []" .
from ‹n'' -as→* n'› ‹∀n'∈set (sourcenodes as). n' ∉ (PDG_BS S)›
have "obs n' (PDG_BS S) ⊆ obs n'' (PDG_BS S)" by(rule path_obs_subset)
show ?thesis
proof(cases "obs n' (PDG_BS S) = obs n'' (PDG_BS S)")
case True
with ‹n'' -as→* n'› ‹valid_edge a› ‹obs n' (PDG_BS S) = {n'}› more_than_one
show ?thesis
apply(rule_tac x="a" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="as" in exI)
by(fastforce intro:empty_path)
next
case False
with ‹obs n' (PDG_BS S) ⊆ obs n'' (PDG_BS S)›
have "obs n' (PDG_BS S) ⊂ obs n'' (PDG_BS S)" by simp
with ‹obs n' (PDG_BS S) = {n'}› obtain ni where "n' ∈ obs n'' (PDG_BS S)"
and "ni ∈ obs n'' (PDG_BS S)" and "n' ≠ ni" by auto
from IH[OF this ‹obs n' (PDG_BS S) = {n'}›
‹∀n'∈set (sourcenodes as). n' ∉ (PDG_BS S)› ‹as ≠ []›] obtain a' as' as''
where "n'' -as'→* sourcenode a'" and "targetnode a' -as''→* n'"
and "valid_edge a'" and [simp]:"as = as'@a'#as''"
and "obs (targetnode a') (PDG_BS S) = {n'}"
and more_than_one':"¬ (∃m. obs (sourcenode a') (PDG_BS S) = {m} ∨
obs (sourcenode a') (PDG_BS S) = {})"
by blast
from ‹n'' -as'→* sourcenode a'› ‹valid_edge a›
have "n -a#as'→* sourcenode a'" by(fastforce intro:path.Cons_path)
with ‹targetnode a' -as''→* n'› ‹obs (targetnode a') (PDG_BS S) = {n'}›
more_than_one' ‹valid_edge a'› show ?thesis
apply(rule_tac x="a'" in exI)
apply(rule_tac x="a#as'" in exI)
apply(rule_tac x="as''" in exI)
by fastforce
qed
qed
qed simp
then obtain a as' as'' where "valid_edge a"
and "obs (targetnode a) (PDG_BS S) = {nx}"
and more_than_one:"¬ (∃m. obs (sourcenode a) (PDG_BS S) = {m} ∨
obs (sourcenode a) (PDG_BS S) = {})"
by blast
have "sourcenode a ∉ (PDG_BS S)"
proof(rule ccontr)
assume "¬ sourcenode a ∉ PDG_BS S"
hence "sourcenode a ∈ PDG_BS S" by simp
with ‹valid_edge a› have "obs (sourcenode a) (PDG_BS S) = {sourcenode a}"
by(fastforce intro!:n_in_obs)
with more_than_one show False by simp
qed
with ‹valid_edge a›
have "obs (targetnode a) (PDG_BS S) ⊆ obs (sourcenode a) (PDG_BS S)"
by(rule edge_obs_subset)
with ‹obs (targetnode a) (PDG_BS S) = {nx}›
have "nx ∈ obs (sourcenode a) (PDG_BS S)" by simp
with more_than_one obtain m where "m ∈ obs (sourcenode a) (PDG_BS S)"
and "nx ≠ m" by auto
from ‹m ∈ obs (sourcenode a) (PDG_BS S)›
have "valid_node m" by(fastforce dest:in_obs_valid)
from ‹obs (targetnode a) (PDG_BS S) = {nx}› have "valid_node nx"
by(fastforce dest:in_obs_valid)
show False
proof(cases "m strongly-postdominates (sourcenode a)")
case True
with ‹nx ∈ obs (sourcenode a) (PDG_BS S)› ‹m ∈ obs (sourcenode a) (PDG_BS S)›
have "m strongly-postdominates nx"
by(fastforce intro:strong_postdominate_path_targetnode elim:obs.cases)
with ‹nx ≠ m› have "¬ nx strongly-postdominates m"
by(fastforce dest:strong_postdominate_antisym)
have "(_Exit_) -[]→* (_Exit_)" by(fastforce intro:empty_path)
with ‹m strongly-postdominates nx› have "nx ≠ (_Exit_)"
by(fastforce simp:strong_postdominate_def sourcenodes_def postdominate_def)
have "¬ nx strongly-postdominates (sourcenode a)"
proof(rule ccontr)
assume "¬ ¬ nx strongly-postdominates sourcenode a"
hence "nx strongly-postdominates sourcenode a" by simp
from ‹m ∈ obs (sourcenode a) (PDG_BS S)› ‹nx ∈ obs (sourcenode a) (PDG_BS S)›
obtain asx' where "sourcenode a -asx'→* m" and "nx ∉ set(sourcenodes asx')"
by(fastforce elim:obs.cases)
with ‹nx strongly-postdominates sourcenode a› have "nx strongly-postdominates m"
by(rule strong_postdominate_path_targetnode)
with ‹¬ nx strongly-postdominates m› show False by simp
qed
with ‹nx ∈ obs (sourcenode a) (PDG_BS S)› ‹valid_node nx› ‹nx ≠ (_Exit_)›
show False by(fastforce dest:obs_strong_postdominate)
next
case False
show False
proof(cases "m = Exit")
case True
from ‹m ∈ obs (sourcenode a) (PDG_BS S)› ‹nx ∈ obs (sourcenode a) (PDG_BS S)›
obtain xs where "sourcenode a -xs→* m" and "nx ∉ set(sourcenodes xs)"
by(fastforce elim:obsE)
obtain x' xs' where [simp]:"xs = x'#xs'"
proof(cases xs)
case Nil
with ‹sourcenode a -xs→* m› have [simp]:"sourcenode a = m" by fastforce
with ‹m ∈ obs (sourcenode a) (PDG_BS S)›
have "m ∈ (PDG_BS S)" by (metis obsE)
with ‹valid_node m› have "obs m (PDG_BS S) = {m}"
by(rule n_in_obs)
with ‹nx ∈ obs (sourcenode a) (PDG_BS S)› ‹nx ≠ m› have False
by fastforce
thus ?thesis by simp
qed blast
from ‹sourcenode a -xs→* m› have "sourcenode a = sourcenode x'"
and "valid_edge x'" and "targetnode x' -xs'→* m"
by(auto elim:path_split_Cons)
from ‹targetnode x' -xs'→* m› ‹nx ∉ set(sourcenodes xs)› ‹valid_edge x'›
‹valid_node m› True
have "¬ nx strongly-postdominates (targetnode x')"
by(fastforce simp:strong_postdominate_def postdominate_def sourcenodes_def)
from ‹nx ≠ m› True have "nx ≠ (_Exit_)" by simp
with ‹obs (targetnode a) (PDG_BS S) = {nx}›
have "nx strongly-postdominates (targetnode a)"
by(fastforce intro:obs_strong_postdominate)
from ‹obs (targetnode a) (PDG_BS S) = {nx}›
obtain ys where "targetnode a -ys→* nx"
and "∀nx' ∈ set(sourcenodes ys). nx' ∉ (PDG_BS S)"
and "nx ∈ (PDG_BS S)" by(fastforce elim:obsE)
hence "nx ∉ set(sourcenodes ys)"by fastforce
have "sourcenode a ≠ nx"
proof
assume "sourcenode a = nx"
from ‹nx ∈ obs (sourcenode a) (PDG_BS S)›
have "nx ∈ (PDG_BS S)" by -(erule obsE)
with ‹valid_node nx› have "obs nx (PDG_BS S) = {nx}" by -(erule n_in_obs)
with ‹sourcenode a = nx› ‹m ∈ obs (sourcenode a) (PDG_BS S)›
‹nx ≠ m› show False by fastforce
qed
with ‹nx ∉ set(sourcenodes ys)› have "nx ∉ set(sourcenodes (a#ys))"
by(fastforce simp:sourcenodes_def)
from ‹valid_edge a› ‹targetnode a -ys→* nx›
have "sourcenode a -a#ys→* nx" by(fastforce intro:Cons_path)
from ‹sourcenode a -a#ys→* nx› ‹nx ∉ set(sourcenodes (a#ys))›
‹nx strongly-postdominates (targetnode a)› ‹valid_edge x'›
‹¬ nx strongly-postdominates (targetnode x')› ‹sourcenode a = sourcenode x'›
have "(sourcenode a) weakly controls nx"
by(fastforce simp:weak_control_dependence_def)
with ‹nx ∈ (PDG_BS S)› have "sourcenode a ∈ (PDG_BS S)"
by(rule cd_closed)
with ‹valid_edge a› have "obs (sourcenode a) (PDG_BS S) = {sourcenode a}"
by(fastforce intro!:n_in_obs)
with ‹m ∈ obs (sourcenode a) (PDG_BS S)›
‹nx ∈ obs (sourcenode a) (PDG_BS S)› ‹nx ≠ m›
show False by simp
next
case False
with ‹m ∈ obs (sourcenode a) (PDG_BS S)› ‹valid_node m›
‹¬ m strongly-postdominates sourcenode a›
show False by(fastforce dest:obs_strong_postdominate)
qed
qed
qed
lemma WeakPDGBackwardSliceCorrect:
"BackwardSlice sourcenode targetnode kind valid_edge
(_Entry_) Def Use state_val PDG_BS"
proof(unfold_locales)
fix n S assume "n ∈ PDG_BS S"
thus "valid_node n" by(rule PDG_BS_valid_node)
next
fix n S assume "valid_node n" and "n ∈ S"
thus "n ∈ PDG_BS S" by(fastforce intro:PDG_path_Nil simp:PDG_BS_def)
next
fix n' S n V assume "n' ∈ PDG_BS S" and "n influences V in n'"
thus "n ∈ PDG_BS S"
by(auto dest:PDG.PDG_path_ddep[OF PDG_wcd,OF PDG.PDG_ddep_edge[OF PDG_wcd]]
dest:PDG_path_Append simp:PDG_BS_def split:if_split_asm)
next
fix n S
have "(∃m. obs n (PDG_BS S) = {m}) ∨ obs n (PDG_BS S) = {}"
by(rule obs_singleton)
thus "finite (obs n (PDG_BS S))" by fastforce
next
fix n S
have "(∃m. obs n (PDG_BS S) = {m}) ∨ obs n (PDG_BS S) = {}"
by(rule obs_singleton)
thus "card (obs n (PDG_BS S)) ≤ 1" by fastforce
qed
end
subsection‹Weak order dependence›
context CFG_wf begin
lemma obs_singleton:
shows "(∃m. obs n (wod_backward_slice S) = {m}) ∨
obs n (wod_backward_slice S) = {}"
proof(rule ccontr)
let ?WOD_BS = "wod_backward_slice S"
assume "¬ ((∃m. obs n ?WOD_BS = {m}) ∨ obs n ?WOD_BS = {})"
hence "∃nx nx'. nx ∈ obs n ?WOD_BS ∧ nx' ∈ obs n ?WOD_BS ∧
nx ≠ nx'" by auto
then obtain nx nx' where "nx ∈ obs n ?WOD_BS" and "nx' ∈ obs n ?WOD_BS"
and "nx ≠ nx'" by auto
from ‹nx ∈ obs n ?WOD_BS› obtain as where "n -as→* nx"
and "∀n' ∈ set(sourcenodes as). n' ∉ ?WOD_BS" and "nx ∈ ?WOD_BS"
by(erule obsE)
from ‹n -as→* nx› have "valid_node nx" by(fastforce dest:path_valid_node)
with ‹nx ∈ ?WOD_BS› have "obs nx ?WOD_BS = {nx}" by -(rule n_in_obs)
with ‹n -as→* nx› ‹nx ∈ obs n ?WOD_BS› ‹nx' ∈ obs n ?WOD_BS› ‹nx ≠ nx'›
have "as ≠ []" by(fastforce elim:path.cases)
with ‹n -as→* nx› ‹nx ∈ obs n ?WOD_BS› ‹nx' ∈ obs n ?WOD_BS› ‹nx ≠ nx'›
‹obs nx ?WOD_BS = {nx}› ‹∀n' ∈ set(sourcenodes as). n' ∉ ?WOD_BS›
have "∃a as' as''. n -as'→* sourcenode a ∧ targetnode a -as''→* nx ∧
valid_edge a ∧ as = as'@a#as'' ∧
obs (targetnode a) ?WOD_BS = {nx} ∧
(¬ (∃m. obs (sourcenode a) ?WOD_BS = {m} ∨
obs (sourcenode a) ?WOD_BS = {}))"
proof(induct arbitrary:nx' rule:path.induct)
case (Cons_path n'' as n' a n)
note [simp] = ‹sourcenode a = n›[THEN sym] ‹targetnode a = n''›[THEN sym]
note more_than_one = ‹n' ∈ obs n (?WOD_BS)› ‹nx' ∈ obs n (?WOD_BS)› ‹n' ≠ nx'›
note IH = ‹⋀nx'. ⟦n' ∈ obs n'' (?WOD_BS); nx' ∈ obs n'' (?WOD_BS); n' ≠ nx';
obs n' (?WOD_BS) = {n'}; ∀n'∈set (sourcenodes as). n' ∉ (?WOD_BS); as ≠ []⟧
⟹ ∃a as' as''. n'' -as'→* sourcenode a ∧ targetnode a -as''→* n' ∧
valid_edge a ∧ as = as'@a#as'' ∧ obs (targetnode a) (?WOD_BS) = {n'} ∧
(¬ (∃m. obs (sourcenode a) (?WOD_BS) = {m} ∨
obs (sourcenode a) (?WOD_BS) = {}))›
from ‹∀n'∈set (sourcenodes (a#as)). n' ∉ (?WOD_BS)›
have "∀n'∈set (sourcenodes as). n' ∉ (?WOD_BS)" and "sourcenode a ∉ (?WOD_BS)"
by(simp_all add:sourcenodes_def)
show ?case
proof(cases "as = []")
case True
with ‹n'' -as→* n'› have [simp]:"n' = n''" by(fastforce elim:path.cases)
from more_than_one
have "¬ (∃m. obs (sourcenode a) (?WOD_BS) = {m} ∨
obs (sourcenode a) (?WOD_BS) = {})"
by auto
with ‹obs n' (?WOD_BS) = {n'}› True ‹valid_edge a› show ?thesis
apply(rule_tac x="a" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="[]" in exI)
by(auto intro!:empty_path)
next
case False
hence "as ≠ []" .
from ‹n'' -as→* n'› ‹∀n'∈set (sourcenodes as). n' ∉ (?WOD_BS)›
have "obs n' (?WOD_BS) ⊆ obs n'' (?WOD_BS)" by(rule path_obs_subset)
show ?thesis
proof(cases "obs n' (?WOD_BS) = obs n'' (?WOD_BS)")
case True
with ‹n'' -as→* n'› ‹valid_edge a› ‹obs n' (?WOD_BS) = {n'}› more_than_one
show ?thesis
apply(rule_tac x="a" in exI)
apply(rule_tac x="[]" in exI)
apply(rule_tac x="as" in exI)
by(fastforce intro:empty_path)
next
case False
with ‹obs n' (?WOD_BS) ⊆ obs n'' (?WOD_BS)›
have "obs n' (?WOD_BS) ⊂ obs n'' (?WOD_BS)" by simp
with ‹obs n' (?WOD_BS) = {n'}› obtain ni where "n' ∈ obs n'' (?WOD_BS)"
and "ni ∈ obs n'' (?WOD_BS)" and "n' ≠ ni" by auto
from IH[OF this ‹obs n' (?WOD_BS) = {n'}›
‹∀n'∈set (sourcenodes as). n' ∉ (?WOD_BS)› ‹as ≠ []›] obtain a' as' as''
where "n'' -as'→* sourcenode a'" and "targetnode a' -as''→* n'"
and "valid_edge a'" and [simp]:"as = as'@a'#as''"
and "obs (targetnode a') (?WOD_BS) = {n'}"
and more_than_one':"¬ (∃m. obs (sourcenode a') (?WOD_BS) = {m} ∨
obs (sourcenode a') (?WOD_BS) = {})"
by blast
from ‹n'' -as'→* sourcenode a'› ‹valid_edge a›
have "n -a#as'→* sourcenode a'" by(fastforce intro:path.Cons_path)
with ‹targetnode a' -as''→* n'› ‹obs (targetnode a') (?WOD_BS) = {n'}›
more_than_one' ‹valid_edge a'› show ?thesis
apply(rule_tac x="a'" in exI)
apply(rule_tac x="a#as'" in exI)
apply(rule_tac x="as''" in exI)
by fastforce
qed
qed
qed simp
then obtain a as' as'' where "valid_edge a"
and "obs (targetnode a) (?WOD_BS) = {nx}"
and more_than_one:"¬ (∃m. obs (sourcenode a) (?WOD_BS) = {m} ∨
obs (sourcenode a) (?WOD_BS) = {})"
by blast
have "sourcenode a ∉ (?WOD_BS)"
proof(rule ccontr)
assume "¬ sourcenode a ∉ ?WOD_BS"
hence "sourcenode a ∈ ?WOD_BS" by simp
with ‹valid_edge a› have "obs (sourcenode a) (?WOD_BS) = {sourcenode a}"
by(fastforce intro!:n_in_obs)
with more_than_one show False by simp
qed
with ‹valid_edge a›
have "obs (targetnode a) (?WOD_BS) ⊆ obs (sourcenode a) (?WOD_BS)"
by(rule edge_obs_subset)
with ‹obs (targetnode a) (?WOD_BS) = {nx}›
have "nx ∈ obs (sourcenode a) (?WOD_BS)" by simp
with more_than_one obtain m where "m ∈ obs (sourcenode a) (?WOD_BS)"
and "nx ≠ m" by auto
with ‹nx ∈ obs (sourcenode a) (?WOD_BS)› obtain as2
where "sourcenode a -as2→* m" and "nx ∉ set(sourcenodes as2)"
by(fastforce elim:obsE)
from ‹nx ∈ obs (sourcenode a) (?WOD_BS)› ‹m ∈ obs (sourcenode a) (?WOD_BS)›
obtain as1 where "sourcenode a -as1→* nx" and "m ∉ set(sourcenodes as1)"
by(fastforce elim:obsE)
from ‹obs (targetnode a) (?WOD_BS) = {nx}› obtain asx
where "targetnode a -asx→* nx" by(fastforce elim:obsE)
have "∀asx'. targetnode a -asx'→* m ⟶ nx ∈ set(sourcenodes asx')"
proof(rule ccontr)
assume "¬ (∀asx'. targetnode a -asx'→* m ⟶ nx ∈ set (sourcenodes asx'))"
then obtain asx' where "targetnode a -asx'→* m" and "nx ∉ set (sourcenodes asx')"
by blast
show False
proof(cases "∀nx ∈ set(sourcenodes asx'). nx ∉ ?WOD_BS")
case True
with ‹targetnode a -asx'→* m› ‹m ∈ obs (sourcenode a) (?WOD_BS)›
have "m ∈ obs (targetnode a) ?WOD_BS" by(fastforce intro:obs_elem elim:obsE)
with ‹nx ≠ m› ‹obs (targetnode a) (?WOD_BS) = {nx}› show False by simp
next
case False
hence "∃nx ∈ set(sourcenodes asx'). nx ∈ ?WOD_BS" by blast
then obtain nx' ns ns' where "sourcenodes asx' = ns@nx'#ns'" and "nx' ∈ ?WOD_BS"
and "∀nx ∈ set ns. nx ∉ ?WOD_BS" by(fastforce elim!:split_list_first_propE)
from ‹sourcenodes asx' = ns@nx'#ns'› obtain ax ai ai'
where [simp]:"asx' = ai@ax#ai'" "ns = sourcenodes ai" "nx' = sourcenode ax"
by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
from ‹targetnode a -asx'→* m› have "targetnode a -ai→* sourcenode ax"
by(fastforce dest:path_split)
with ‹nx' ∈ ?WOD_BS› ‹∀nx ∈ set ns. nx ∉ ?WOD_BS›
have "nx' ∈ obs (targetnode a) ?WOD_BS" by(fastforce intro:obs_elem)
with ‹obs (targetnode a) (?WOD_BS) = {nx}› have "nx' = nx" by simp
with ‹nx ∉ set (sourcenodes asx')› show False by(simp add:sourcenodes_def)
qed
qed
with ‹nx ≠ m› ‹sourcenode a -as1→* nx› ‹m ∉ set(sourcenodes as1)›
‹sourcenode a -as2→* m› ‹nx ∉ set(sourcenodes as2)› ‹valid_edge a›
‹targetnode a -asx→* nx›
have "sourcenode a ⟶⇩w⇩o⇩d nx,m" by(simp add:wod_def,blast)
with ‹nx ∈ obs (sourcenode a) (?WOD_BS)› ‹m ∈ obs (sourcenode a) (?WOD_BS)›
have "sourcenode a ∈ ?WOD_BS" by(fastforce elim:cd_closed elim:obsE)
with ‹sourcenode a ∉ ?WOD_BS› show False by simp
qed
lemma WODBackwardSliceCorrect:
"BackwardSlice sourcenode targetnode kind valid_edge
(_Entry_) Def Use state_val wod_backward_slice"
proof(unfold_locales)
fix n S assume "n ∈ wod_backward_slice S"
thus "valid_node n" by(rule wod_backward_slice_valid_node)
next
fix n S assume "valid_node n" and "n ∈ S"
thus "n ∈ wod_backward_slice S" by(rule refl)
next
fix n' S n V assume "n' ∈ wod_backward_slice S" "n influences V in n'"
thus "n ∈ wod_backward_slice S"
by -(rule dd_closed)
next
fix n S
have "(∃m. obs n (wod_backward_slice S) = {m}) ∨
obs n (wod_backward_slice S) = {}"
by(rule obs_singleton)
thus "finite (obs n (wod_backward_slice S))" by fastforce
next
fix n S
have "(∃m. obs n (wod_backward_slice S) = {m}) ∨ obs n (wod_backward_slice S) = {}"
by(rule obs_singleton)
thus "card (obs n (wod_backward_slice S)) ≤ 1" by fastforce
qed
end
end
Theory ControlDependenceRelations
section ‹Relations between control dependences›
theory ControlDependenceRelations
imports WeakOrderDependence StandardControlDependence
begin
context StrongPostdomination begin
lemma standard_control_implies_weak_order:
assumes "n controls⇩s n'" shows "n ⟶⇩w⇩o⇩d n',(_Exit_)"
proof -
from ‹n controls⇩s n'› obtain as a a' as' where "as = a#as'"
and "n' ∉ set(sourcenodes as)" and "n -as→* n'"
and "n' postdominates (targetnode a)"
and "valid_edge a'" and "sourcenode a' = n"
and "¬ n' postdominates (targetnode a')"
by(auto simp:standard_control_dependence_def)
from ‹n -as→* n'› ‹as = a#as'› have "sourcenode a = n" by(auto elim:path.cases)
from ‹n -as→* n'› ‹as = a#as'› ‹n' ∉ set(sourcenodes as)› have "n ≠ n'"
by(induct rule:path.induct,auto simp:sourcenodes_def)
from ‹n -as→* n'› ‹as = a#as'› have "valid_edge a"
by(auto elim:path.cases)
from ‹n controls⇩s n'› have "n' ≠ (_Exit_)"
by(fastforce dest:Exit_not_standard_control_dependent)
from ‹n -as→* n'› have "(_Exit_) ∉ set (sourcenodes as)" by fastforce
from ‹n -as→* n'› have "valid_node n" and "valid_node n'"
by(auto dest:path_valid_node)
with ‹¬ n' postdominates (targetnode a')› ‹valid_edge a'›
obtain asx where "targetnode a' -asx→* (_Exit_)" and "n' ∉ set(sourcenodes asx)"
by(auto simp:postdominate_def)
with ‹valid_edge a'› ‹sourcenode a' = n› have "n -a'#asx→* (_Exit_)"
by(fastforce intro:Cons_path)
with ‹n ≠ n'› ‹sourcenode a' = n› ‹n' ∉ set(sourcenodes asx)›
have "n' ∉ set(sourcenodes (a'#asx))" by(simp add:sourcenodes_def)
from ‹n' postdominates (targetnode a)›
obtain asx' where "targetnode a -asx'→* n'" by(erule postdominate_implies_path)
from ‹n' postdominates (targetnode a)›
have "∀as'. targetnode a -as'→* (_Exit_) ⟶ n' ∈ set(sourcenodes as')"
by(auto simp:postdominate_def)
with ‹n' ≠ (_Exit_)› ‹n -as→* n'› ‹(_Exit_) ∉ set (sourcenodes as)›
‹n -a'#asx→* (_Exit_)› ‹n' ∉ set(sourcenodes (a'#asx))›
‹valid_edge a› ‹sourcenode a = n› ‹targetnode a -asx'→* n'›
show ?thesis by(auto simp:wod_def)
qed
end
end
Theory Com
chapter ‹Instantiating the Framework with a simple While-Language›
section ‹Commands›
theory Com imports Main begin
subsection ‹Variables and Values›
type_synonym vname = string
datatype val
= Bool bool
| Intg int
abbreviation "true == Bool True"
abbreviation "false == Bool False"
subsection ‹Expressions and Commands›
datatype bop = Eq | And | Less | Add | Sub
datatype expr
= Val val
| Var vname
| BinOp expr bop expr ("_ «_» _" [80,0,81] 80)
fun binop :: "bop ⇒ val ⇒ val ⇒ val option"
where "binop Eq v⇩1 v⇩2 = Some(Bool(v⇩1 = v⇩2))"
| "binop And (Bool b⇩1) (Bool b⇩2) = Some(Bool(b⇩1 ∧ b⇩2))"
| "binop Less (Intg i⇩1) (Intg i⇩2) = Some(Bool(i⇩1 < i⇩2))"
| "binop Add (Intg i⇩1) (Intg i⇩2) = Some(Intg(i⇩1 + i⇩2))"
| "binop Sub (Intg i⇩1) (Intg i⇩2) = Some(Intg(i⇩1 - i⇩2))"
| "binop bop v⇩1 v⇩2 = None"
datatype cmd
= Skip
| LAss vname expr ("_:=_" [70,70] 70)
| Seq cmd cmd ("_;;/ _" [61,60] 60)
| Cond expr cmd cmd ("if '(_') _/ else _" [80,79,79] 70)
| While expr cmd ("while '(_') _" [80,79] 70)
fun num_inner_nodes :: "cmd ⇒ nat" ("#:_")
where "#:Skip = 1"
| "#:(V:=e) = 2"
| "#:(c⇩1;;c⇩2) = #:c⇩1 + #:c⇩2"
| "#:(if (b) c⇩1 else c⇩2) = #:c⇩1 + #:c⇩2 + 1"
| "#:(while (b) c) = #:c + 2"
lemma num_inner_nodes_gr_0:"#:c > 0"
by(induct c) auto
lemma [dest]:"#:c = 0 ⟹ False"
by(induct c) auto
subsection ‹The state›
type_synonym state = "vname ⇀ val"
fun "interpret" :: "expr ⇒ state ⇒ val option"
where Val: "interpret (Val v) s = Some v"
| Var: "interpret (Var V) s = s V"
| BinOp: "interpret (e⇩1«bop»e⇩2) s =
(case interpret e⇩1 s of None ⇒ None
| Some v⇩1 ⇒ (case interpret e⇩2 s of None ⇒ None
| Some v⇩2 ⇒ (
case binop bop v⇩1 v⇩2 of None ⇒ None | Some v ⇒ Some v)))"
end
Theory WCFG
section ‹CFG›
theory WCFG imports Com "../Basic/BasicDefs" begin
subsection‹CFG nodes›
datatype w_node = Node nat ("'('_ _ '_')")
| Entry ("'('_Entry'_')")
| Exit ("'('_Exit'_')")
fun label_incr :: "w_node ⇒ nat ⇒ w_node" ("_ ⊕ _" 60)
where "(_ l _) ⊕ i = (_ l + i _)"
| "(_Entry_) ⊕ i = (_Entry_)"
| "(_Exit_) ⊕ i = (_Exit_)"
lemma Exit_label_incr [dest]: "(_Exit_) = n ⊕ i ⟹ n = (_Exit_)"
by(cases n,auto)
lemma label_incr_Exit [dest]: "n ⊕ i = (_Exit_) ⟹ n = (_Exit_)"
by(cases n,auto)
lemma Entry_label_incr [dest]: "(_Entry_) = n ⊕ i ⟹ n = (_Entry_)"
by(cases n,auto)
lemma label_incr_Entry [dest]: "n ⊕ i = (_Entry_) ⟹ n = (_Entry_)"
by(cases n,auto)
lemma label_incr_inj:
"n ⊕ c = n' ⊕ c ⟹ n = n'"
by(cases n)(cases n',auto)+
lemma label_incr_simp:"n ⊕ i = m ⊕ (i + j) ⟹ n = m ⊕ j"
by(cases n,auto,cases m,auto)
lemma label_incr_simp_rev:"m ⊕ (j + i) = n ⊕ i ⟹ m ⊕ j = n"
by(cases n,auto,cases m,auto)
lemma label_incr_start_Node_smaller:
"(_ l _) = n ⊕ i ⟹ n = (_(l - i)_)"
by(cases n,auto)
lemma label_incr_ge:"(_ l _) = n ⊕ i ⟹ l ≥ i"
by(cases n) auto
lemma label_incr_0 [dest]:
"⟦(_0_) = n ⊕ i; i > 0⟧ ⟹ False"
by(cases n) auto
lemma label_incr_0_rev [dest]:
"⟦n ⊕ i = (_0_); i > 0⟧ ⟹ False"
by(cases n) auto
subsection‹CFG edges›
type_synonym w_edge = "(w_node × state edge_kind × w_node)"
inductive While_CFG :: "cmd ⇒ w_node ⇒ state edge_kind ⇒ w_node ⇒ bool"
("_ ⊢ _ -_→ _")
where
WCFG_Entry_Exit:
"prog ⊢ (_Entry_) -(λs. False)⇩√→ (_Exit_)"
| WCFG_Entry:
"prog ⊢ (_Entry_) -(λs. True)⇩√→ (_0_)"
| WCFG_Skip:
"Skip ⊢ (_0_) -⇑id→ (_Exit_)"
| WCFG_LAss:
"V:=e ⊢ (_0_) -⇑(λs. s(V:=(interpret e s)))→ (_1_)"
| WCFG_LAssSkip:
"V:=e ⊢ (_1_) -⇑id→ (_Exit_)"
| WCFG_SeqFirst:
"⟦c⇩1 ⊢ n -et→ n'; n' ≠ (_Exit_)⟧ ⟹ c⇩1;;c⇩2 ⊢ n -et→ n'"
| WCFG_SeqConnect:
"⟦c⇩1 ⊢ n -et→ (_Exit_); n ≠ (_Entry_)⟧ ⟹ c⇩1;;c⇩2 ⊢ n -et→ (_0_) ⊕ #:c⇩1"
| WCFG_SeqSecond:
"⟦c⇩2 ⊢ n -et→ n'; n ≠ (_Entry_)⟧ ⟹ c⇩1;;c⇩2 ⊢ n ⊕ #:c⇩1 -et→ n' ⊕ #:c⇩1"
| WCFG_CondTrue:
"if (b) c⇩1 else c⇩2 ⊢ (_0_) -(λs. interpret b s = Some true)⇩√→ (_0_) ⊕ 1"
| WCFG_CondFalse:
"if (b) c⇩1 else c⇩2 ⊢ (_0_) -(λs. interpret b s = Some false)⇩√→ (_0_) ⊕ (#:c⇩1 + 1)"
| WCFG_CondThen:
"⟦c⇩1 ⊢ n -et→ n'; n ≠ (_Entry_)⟧ ⟹ if (b) c⇩1 else c⇩2 ⊢ n ⊕ 1 -et→ n' ⊕ 1"
| WCFG_CondElse:
"⟦c⇩2 ⊢ n -et→ n'; n ≠ (_Entry_)⟧
⟹ if (b) c⇩1 else c⇩2 ⊢ n ⊕ (#:c⇩1 + 1) -et→ n' ⊕ (#:c⇩1 + 1)"
| WCFG_WhileTrue:
"while (b) c' ⊢ (_0_) -(λs. interpret b s = Some true)⇩√→ (_0_) ⊕ 2"
| WCFG_WhileFalse:
"while (b) c' ⊢ (_0_) -(λs. interpret b s = Some false)⇩√→ (_1_)"
| WCFG_WhileFalseSkip:
"while (b) c' ⊢ (_1_) -⇑id→ (_Exit_)"
| WCFG_WhileBody:
"⟦c' ⊢ n -et→ n'; n ≠ (_Entry_); n' ≠ (_Exit_)⟧
⟹ while (b) c' ⊢ n ⊕ 2 -et→ n' ⊕ 2"
| WCFG_WhileBodyExit:
"⟦c' ⊢ n -et→ (_Exit_); n ≠ (_Entry_)⟧ ⟹ while (b) c' ⊢ n ⊕ 2 -et→ (_0_)"
lemmas WCFG_intros = While_CFG.intros[split_format (complete)]
lemmas WCFG_elims = While_CFG.cases[split_format (complete)]
lemmas WCFG_induct = While_CFG.induct[split_format (complete)]
subsection ‹Some lemmas about the CFG›
lemma WCFG_Exit_no_sourcenode [dest]:
"prog ⊢ (_Exit_) -et→ n' ⟹ False"
by(induct prog n≡"(_Exit_)" et n' rule:WCFG_induct,auto)
lemma WCFG_Entry_no_targetnode [dest]:
"prog ⊢ n -et→ (_Entry_) ⟹ False"
by(induct prog n et n'≡"(_Entry_)" rule:WCFG_induct,auto)
lemma WCFG_sourcelabel_less_num_nodes:
"prog ⊢ (_ l _) -et→ n' ⟹ l < #:prog"
proof(induct prog "(_ l _)" et n' arbitrary:l rule:WCFG_induct)
case (WCFG_SeqFirst c⇩1 et n' c⇩2)
from ‹l < #:c⇩1› show ?case by simp
next
case (WCFG_SeqConnect c⇩1 et c⇩2)
from ‹l < #:c⇩1› show ?case by simp
next
case (WCFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹⋀l. n = (_ l _) ⟹ l < #:c⇩2›
from ‹n ⊕ #:c⇩1 = (_ l _)› obtain l' where "n = (_ l' _)" by(cases n) auto
from IH[OF this] have "l' < #:c⇩2" .
with ‹n ⊕ #:c⇩1 = (_ l _)› ‹n = (_ l' _)› show ?case by simp
next
case (WCFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹⋀l. n = (_ l _) ⟹ l < #:c⇩1›
from ‹n ⊕ 1 = (_ l _)› obtain l' where "n = (_ l' _)" by(cases n) auto
from IH[OF this] have "l' < #:c⇩1" .
with ‹n ⊕ 1 = (_ l _)› ‹n = (_ l' _)› show ?case by simp
next
case (WCFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹⋀l. n = (_ l _) ⟹ l < #:c⇩2›
from ‹n ⊕ (#:c⇩1 + 1) = (_ l _)› obtain l' where "n = (_ l' _)" by(cases n) auto
from IH[OF this] have "l' < #:c⇩2" .
with ‹n ⊕ (#:c⇩1 + 1) = (_ l _)› ‹n = (_ l' _)› show ?case by simp
next
case (WCFG_WhileBody c' n et n' b)
note IH = ‹⋀l. n = (_ l _) ⟹ l < #:c'›
from ‹n ⊕ 2 = (_ l _)› obtain l' where "n = (_ l' _)" by(cases n) auto
from IH[OF this] have "l' < #:c'" .
with ‹n ⊕ 2 = (_ l _)› ‹n = (_ l' _)› show ?case by simp
next
case (WCFG_WhileBodyExit c' n et b)
note IH = ‹⋀l. n = (_ l _) ⟹ l < #:c'›
from ‹n ⊕ 2 = (_ l _)› obtain l' where "n = (_ l' _)" by(cases n) auto
from IH[OF this] have "l' < #:c'" .
with ‹n ⊕ 2 = (_ l _)› ‹n = (_ l' _)› show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)
lemma WCFG_targetlabel_less_num_nodes:
"prog ⊢ n -et→ (_ l _) ⟹ l < #:prog"
proof(induct prog n et "(_ l _)" arbitrary:l rule:WCFG_induct)
case (WCFG_SeqFirst c⇩1 n et c⇩2)
from ‹l < #:c⇩1› show ?case by simp
next
case (WCFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹⋀l. n' = (_ l _) ⟹ l < #:c⇩2›
from ‹n' ⊕ #:c⇩1 = (_ l _)› obtain l' where "n' = (_ l' _)" by(cases n') auto
from IH[OF this] have "l' < #:c⇩2" .
with ‹n' ⊕ #:c⇩1 = (_ l _)› ‹n' = (_ l' _)› show ?case by simp
next
case (WCFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹⋀l. n' = (_ l _) ⟹ l < #:c⇩1›
from ‹n' ⊕ 1 = (_ l _)› obtain l' where "n' = (_ l' _)" by(cases n') auto
from IH[OF this] have "l' < #:c⇩1" .
with ‹n' ⊕ 1 = (_ l _)› ‹n' = (_ l' _)› show ?case by simp
next
case (WCFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹⋀l. n' = (_ l _) ⟹ l < #:c⇩2›
from ‹n' ⊕ (#:c⇩1 + 1) = (_ l _)› obtain l' where "n' = (_ l' _)" by(cases n') auto
from IH[OF this] have "l' < #:c⇩2" .
with ‹n' ⊕ (#:c⇩1 + 1) = (_ l _)› ‹n' = (_ l' _)› show ?case by simp
next
case (WCFG_WhileBody c' n et n' b)
note IH = ‹⋀l. n' = (_ l _) ⟹ l < #:c'›
from ‹n' ⊕ 2 = (_ l _)› obtain l' where "n' = (_ l' _)" by(cases n') auto
from IH[OF this] have "l' < #:c'" .
with ‹n' ⊕ 2 = (_ l _)› ‹n' = (_ l' _)› show ?case by simp
qed (auto simp:num_inner_nodes_gr_0)
lemma WCFG_EntryD:
"prog ⊢ (_Entry_) -et→ n'
⟹ (n' = (_Exit_) ∧ et = (λs. False)⇩√) ∨ (n' = (_0_) ∧ et = (λs. True)⇩√)"
by(induct prog n≡"(_Entry_)" et n' rule:WCFG_induct,auto)
declare One_nat_def [simp del] add_2_eq_Suc' [simp del]
lemma WCFG_edge_det:
"⟦prog ⊢ n -et→ n'; prog ⊢ n -et'→ n'⟧ ⟹ et = et'"
proof(induct rule:WCFG_induct)
case WCFG_Entry_Exit thus ?case by(fastforce dest:WCFG_EntryD)
next
case WCFG_Entry thus ?case by(fastforce dest:WCFG_EntryD)
next
case WCFG_Skip thus ?case by(fastforce elim:WCFG_elims)
next
case WCFG_LAss thus ?case by(fastforce elim:WCFG_elims)
next
case WCFG_LAssSkip thus ?case by(fastforce elim:WCFG_elims)
next
case (WCFG_SeqFirst c⇩1 n et n' c⇩2)
note IH = ‹c⇩1 ⊢ n -et'→ n' ⟹ et = et'›
from ‹c⇩1 ⊢ n -et→ n'› ‹n' ≠ (_Exit_)› obtain l where "n' = (_ l _)"
by (cases n') auto
with ‹c⇩1 ⊢ n -et→ n'› have "l < #:c⇩1"
by(fastforce intro:WCFG_targetlabel_less_num_nodes)
with ‹c⇩1;;c⇩2 ⊢ n -et'→ n'› ‹n' = (_ l _)› have "c⇩1 ⊢ n -et'→ n'"
by(fastforce elim:WCFG_elims intro:WCFG_intros dest:label_incr_ge)
from IH[OF this] show ?case .
next
case (WCFG_SeqConnect c⇩1 n et c⇩2)
note IH = ‹c⇩1 ⊢ n -et'→ (_Exit_) ⟹ et = et'›
from ‹c⇩1 ⊢ n -et→ (_Exit_)› ‹n ≠ (_Entry_)› obtain l where "n = (_ l _)"
by (cases n) auto
with ‹c⇩1 ⊢ n -et→ (_Exit_)› have "l < #:c⇩1"
by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
with ‹c⇩1;;c⇩2 ⊢ n -et'→ (_ 0 _) ⊕ #:c⇩1› ‹n = (_ l _)› have "c⇩1 ⊢ n -et'→ (_Exit_)"
by(fastforce elim:WCFG_elims dest:WCFG_targetlabel_less_num_nodes label_incr_ge)
from IH[OF this] show ?case .
next
case (WCFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹c⇩2 ⊢ n -et'→ n' ⟹ et = et'›
from ‹c⇩2 ⊢ n -et→ n'› ‹n ≠ (_Entry_)› obtain l where "n = (_ l _)"
by (cases n) auto
with ‹c⇩2 ⊢ n -et→ n'› have "l < #:c⇩2"
by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
with ‹c⇩1;;c⇩2 ⊢ n ⊕ #:c⇩1 -et'→ n' ⊕ #:c⇩1› ‹n = (_ l _)› have "c⇩2 ⊢ n -et'→ n'"
by -(erule WCFG_elims,(fastforce dest:WCFG_sourcelabel_less_num_nodes label_incr_ge
dest!:label_incr_inj)+)
from IH[OF this] show ?case .
next
case WCFG_CondTrue thus ?case by(fastforce elim:WCFG_elims)
next
case WCFG_CondFalse thus ?case by(fastforce elim:WCFG_elims)
next
case (WCFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹c⇩1 ⊢ n -et'→ n' ⟹ et = et'›
from ‹c⇩1 ⊢ n -et→ n'› ‹n ≠ (_Entry_)› obtain l where "n = (_ l _)"
by (cases n) auto
with ‹c⇩1 ⊢ n -et→ n'› have "l < #:c⇩1"
by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
with ‹if (b) c⇩1 else c⇩2 ⊢ n ⊕ 1 -et'→ n' ⊕ 1› ‹n = (_ l _)›
have "c⇩1 ⊢ n -et'→ n'"
by -(erule WCFG_elims,(fastforce dest:label_incr_ge label_incr_inj)+)
from IH[OF this] show ?case .
next
case (WCFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹c⇩2 ⊢ n -et'→ n' ⟹ et = et'›
from ‹c⇩2 ⊢ n -et→ n'› ‹n ≠ (_Entry_)› obtain l where "n = (_ l _)"
by (cases n) auto
with ‹c⇩2 ⊢ n -et→ n'› have "l < #:c⇩2"
by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
with ‹if (b) c⇩1 else c⇩2 ⊢ n ⊕ (#:c⇩1 + 1) -et'→ n' ⊕ (#:c⇩1 + 1)› ‹n = (_ l _)›
have "c⇩2 ⊢ n -et'→ n'"
by -(erule WCFG_elims,(fastforce dest:WCFG_sourcelabel_less_num_nodes
label_incr_inj label_incr_ge label_incr_simp_rev)+)
from IH[OF this] show ?case .
next
case WCFG_WhileTrue thus ?case by(fastforce elim:WCFG_elims)
next
case WCFG_WhileFalse thus ?case by(fastforce elim:WCFG_elims)
next
case WCFG_WhileFalseSkip thus ?case by(fastforce elim:WCFG_elims)
next
case (WCFG_WhileBody c' n et n' b)
note IH = ‹c' ⊢ n -et'→ n' ⟹ et = et'›
from ‹c' ⊢ n -et→ n'› ‹n ≠ (_Entry_)› obtain l where "n = (_ l _)"
by (cases n) auto
moreover
with ‹c' ⊢ n -et→ n'› have "l < #:c'"
by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
moreover
from ‹c' ⊢ n -et→ n'› ‹n' ≠ (_Exit_)› obtain l' where "n' = (_ l' _)"
by (cases n') auto
moreover
with ‹c' ⊢ n -et→ n'› have "l' < #:c'"
by(fastforce intro:WCFG_targetlabel_less_num_nodes)
ultimately have "c' ⊢ n -et'→ n'" using ‹while (b) c' ⊢ n ⊕ 2 -et'→ n' ⊕ 2›
by(fastforce elim:WCFG_elims dest:label_incr_start_Node_smaller)
from IH[OF this] show ?case .
next
case (WCFG_WhileBodyExit c' n et b)
note IH = ‹c' ⊢ n -et'→ (_Exit_) ⟹ et = et'›
from ‹c' ⊢ n -et→ (_Exit_)› ‹n ≠ (_Entry_)› obtain l where "n = (_ l _)"
by (cases n) auto
with ‹c' ⊢ n -et→ (_Exit_)› have "l < #:c'"
by(fastforce intro:WCFG_sourcelabel_less_num_nodes)
with ‹while (b) c' ⊢ n ⊕ 2 -et'→ (_0_)› ‹n = (_ l _)›
have "c' ⊢ n -et'→ (_Exit_)"
by -(erule WCFG_elims,auto dest:label_incr_start_Node_smaller)
from IH[OF this] show ?case .
qed
declare One_nat_def [simp] add_2_eq_Suc' [simp]
lemma less_num_nodes_edge_Exit:
obtains l et where "l < #:prog" and "prog ⊢ (_ l _) -et→ (_Exit_)"
proof -
have "∃l et. l < #:prog ∧ prog ⊢ (_ l _) -et→ (_Exit_)"
proof(induct prog)
case Skip
have "0 < #:Skip" by simp
moreover have "Skip ⊢ (_0_) -⇑id→ (_Exit_)" by(rule WCFG_Skip)
ultimately show ?case by blast
next
case (LAss V e)
have "1 < #:(V:=e)" by simp
moreover have "V:=e ⊢ (_1_) -⇑id→ (_Exit_)" by(rule WCFG_LAssSkip)
ultimately show ?case by blast
next
case (Seq prog1 prog2)
from ‹∃l et. l < #:prog2 ∧ prog2 ⊢ (_ l _) -et→ (_Exit_)›
obtain l et where "l < #:prog2" and "prog2 ⊢ (_ l _) -et→ (_Exit_)"
by blast
from ‹prog2 ⊢ (_ l _) -et→ (_Exit_)›
have "prog1;;prog2 ⊢ (_ l _) ⊕ #:prog1 -et→ (_Exit_) ⊕ #:prog1"
by(fastforce intro:WCFG_SeqSecond)
with ‹l < #:prog2› show ?case by(rule_tac x="l + #:prog1" in exI,auto)
next
case (Cond b prog1 prog2)
from ‹∃l et. l < #:prog1 ∧ prog1 ⊢ (_ l _) -et→ (_Exit_)›
obtain l et where "l < #:prog1" and "prog1 ⊢ (_ l _) -et→ (_Exit_)"
by blast
from ‹prog1 ⊢ (_ l _) -et→ (_Exit_)›
have "if (b) prog1 else prog2 ⊢ (_ l _) ⊕ 1 -et→ (_Exit_) ⊕ 1"
by(fastforce intro:WCFG_CondThen)
with ‹l < #:prog1› show ?case by(rule_tac x="l + 1" in exI,auto)
next
case (While b prog')
have "1 < #:(while (b) prog')" by simp
moreover have "while (b) prog' ⊢ (_1_) -⇑id→ (_Exit_)"
by(rule WCFG_WhileFalseSkip)
ultimately show ?case by blast
qed
with that show ?thesis by blast
qed
lemma less_num_nodes_edge:
"l < #:prog ⟹ ∃n et. prog ⊢ n -et→ (_ l _) ∨ prog ⊢ (_ l _) -et→ n"
proof(induct prog arbitrary:l)
case Skip
from ‹l < #:Skip› have "l = 0" by simp
hence "Skip ⊢ (_ l _) -⇑id→ (_Exit_)" by(fastforce intro:WCFG_Skip)
thus ?case by blast
next
case (LAss V e)
from ‹l < #:V:=e› have "l = 0 ∨ l = 1" by auto
thus ?case
proof
assume "l = 0"
hence "V:=e ⊢ (_Entry_) -(λs. True)⇩√→ (_ l _)" by(fastforce intro:WCFG_Entry)
thus ?thesis by blast
next
assume "l = 1"
hence "V:=e ⊢ (_ l _) -⇑id→ (_Exit_)" by(fastforce intro:WCFG_LAssSkip)
thus ?thesis by blast
qed
next
case (Seq prog1 prog2)
note IH1 = ‹⋀l. l < #:prog1 ⟹
∃n et. prog1 ⊢ n -et→ (_ l _) ∨ prog1 ⊢ (_ l _) -et→ n›
note IH2 = ‹⋀l. l < #:prog2 ⟹
∃n et. prog2 ⊢ n -et→ (_ l _) ∨ prog2 ⊢ (_ l _) -et→ n›
show ?case
proof(cases "l < #:prog1")
case True
from IH1[OF this] obtain n et
where "prog1 ⊢ n -et→ (_ l _) ∨ prog1 ⊢ (_ l _) -et→ n" by blast
thus ?thesis
proof
assume "prog1 ⊢ n -et→ (_ l _)"
hence "prog1;; prog2 ⊢ n -et→ (_ l _)" by(fastforce intro:WCFG_SeqFirst)
thus ?thesis by blast
next
assume edge:"prog1 ⊢ (_ l _) -et→ n"
show ?thesis
proof(cases "n = (_Exit_)")
case True
with edge have "prog1;; prog2 ⊢ (_ l _) -et→ (_0_) ⊕ #:prog1"
by(fastforce intro:WCFG_SeqConnect)
thus ?thesis by blast
next
case False
with edge have "prog1;; prog2 ⊢ (_ l _) -et→ n"
by(fastforce intro:WCFG_SeqFirst)
thus ?thesis by blast
qed
qed
next
case False
hence "#:prog1 ≤ l" by simp
then obtain l' where "l = l' + #:prog1" and "l' = l - #:prog1" by simp
from ‹l = l' + #:prog1› ‹l < #:prog1;; prog2› have "l' < #:prog2" by simp
from IH2[OF this] obtain n et
where "prog2 ⊢ n -et→ (_ l' _) ∨ prog2 ⊢ (_ l' _) -et→ n" by blast
thus ?thesis
proof
assume "prog2 ⊢ n -et→ (_ l' _)"
show ?thesis
proof(cases "n = (_Entry_)")
case True
with ‹prog2 ⊢ n -et→ (_ l' _)› have "l' = 0" by(auto dest:WCFG_EntryD)
obtain l'' et'' where "l'' < #:prog1"
and "prog1 ⊢ (_ l'' _) -et''→ (_Exit_)"
by(erule less_num_nodes_edge_Exit)
hence "prog1;;prog2 ⊢ (_ l'' _) -et''→ (_0_) ⊕ #:prog1"
by(fastforce intro:WCFG_SeqConnect)
with ‹l' = 0› ‹l = l' + #:prog1› show ?thesis by simp blast
next
case False
with ‹prog2 ⊢ n -et→ (_ l' _)›
have "prog1;;prog2 ⊢ n ⊕ #:prog1 -et→ (_ l' _) ⊕ #:prog1"
by(fastforce intro:WCFG_SeqSecond)
with ‹l = l' + #:prog1› show ?thesis by simp blast
qed
next
assume "prog2 ⊢ (_ l' _) -et→ n"
hence "prog1;;prog2 ⊢ (_ l' _) ⊕ #:prog1 -et→ n ⊕ #:prog1"
by(fastforce intro:WCFG_SeqSecond)
with ‹l = l' + #:prog1› show ?thesis by simp blast
qed
qed
next
case (Cond b prog1 prog2)
note IH1 = ‹⋀l. l < #:prog1 ⟹
∃n et. prog1 ⊢ n -et→ (_ l _) ∨ prog1 ⊢ (_ l _) -et→ n›
note IH2 = ‹⋀l. l < #:prog2 ⟹
∃n et. prog2 ⊢ n -et→ (_ l _) ∨ prog2 ⊢ (_ l _) -et→ n›
show ?case
proof(cases "l = 0")
case True
have "if (b) prog1 else prog2 ⊢ (_Entry_) -(λs. True)⇩√→ (_0_)"
by(rule WCFG_Entry)
with True show ?thesis by simp blast
next
case False
hence "0 < l" by simp
then obtain l' where "l = l' + 1" and "l' = l - 1" by simp
thus ?thesis
proof(cases "l' < #:prog1")
case True
from IH1[OF this] obtain n et
where "prog1 ⊢ n -et→ (_ l' _) ∨ prog1 ⊢ (_ l' _) -et→ n" by blast
thus ?thesis
proof
assume edge:"prog1 ⊢ n -et→ (_ l' _)"
show ?thesis
proof(cases "n = (_Entry_)")
case True
with edge have "l' = 0" by(auto dest:WCFG_EntryD)
have "if (b) prog1 else prog2 ⊢ (_0_) -(λs. interpret b s = Some true)⇩√→
(_0_) ⊕ 1"
by(rule WCFG_CondTrue)
with ‹l' = 0› ‹l = l' + 1› show ?thesis by simp blast
next
case False
with edge have "if (b) prog1 else prog2 ⊢ n ⊕ 1 -et→ (_ l' _) ⊕ 1"
by(fastforce intro:WCFG_CondThen)
with ‹l = l' + 1› show ?thesis by simp blast
qed
next
assume "prog1 ⊢ (_ l' _) -et→ n"
hence "if (b) prog1 else prog2 ⊢ (_ l' _) ⊕ 1 -et→ n ⊕ 1"
by(fastforce intro:WCFG_CondThen)
with ‹l = l' + 1› show ?thesis by simp blast
qed
next
case False
hence "#:prog1 ≤ l'" by simp
then obtain l'' where "l' = l'' + #:prog1" and "l'' = l' - #:prog1"
by simp
from ‹l' = l'' + #:prog1› ‹l = l' + 1› ‹l < #:(if (b) prog1 else prog2)›
have "l'' < #:prog2" by simp
from IH2[OF this] obtain n et
where "prog2 ⊢ n -et→ (_ l'' _) ∨ prog2 ⊢ (_ l'' _) -et→ n" by blast
thus ?thesis
proof
assume "prog2 ⊢ n -et→ (_ l'' _)"
show ?thesis
proof(cases "n = (_Entry_)")
case True
with ‹prog2 ⊢ n -et→ (_ l'' _)› have "l'' = 0" by(auto dest:WCFG_EntryD)
have "if (b) prog1 else prog2 ⊢ (_0_) -(λs. interpret b s = Some false)⇩√→
(_0_) ⊕ (#:prog1 + 1)"
by(rule WCFG_CondFalse)
with ‹l'' = 0› ‹l' = l'' + #:prog1› ‹l = l' + 1› show ?thesis by simp blast
next
case False
with ‹prog2 ⊢ n -et→ (_ l'' _)›
have "if (b) prog1 else prog2 ⊢ n ⊕ (#:prog1 + 1) -et→
(_ l'' _) ⊕ (#:prog1 + 1)"
by(fastforce intro:WCFG_CondElse)
with ‹l = l' + 1› ‹l' = l'' + #:prog1› show ?thesis by simp blast
qed
next
assume "prog2 ⊢ (_ l'' _) -et→ n"
hence "if (b) prog1 else prog2 ⊢ (_ l'' _) ⊕ (#:prog1 + 1) -et→
n ⊕ (#:prog1 + 1)"
by(fastforce intro:WCFG_CondElse)
with ‹l = l' + 1› ‹l' = l'' + #:prog1› show ?thesis by simp blast
qed
qed
qed
next
case (While b prog')
note IH = ‹⋀l. l < #:prog'
⟹ ∃n et. prog' ⊢ n -et→ (_ l _) ∨ prog' ⊢ (_ l _) -et→ n›
show ?case
proof(cases "l < 1")
case True
have "while (b) prog' ⊢ (_Entry_) -(λs. True)⇩√→ (_0_)" by(rule WCFG_Entry)
with True show ?thesis by simp blast
next
case False
hence "1 ≤ l" by simp
thus ?thesis
proof(cases "l < 2")
case True
with ‹1 ≤ l› have "l = 1" by simp
have "while (b) prog' ⊢ (_0_) -(λs. interpret b s = Some false)⇩√→ (_1_)"
by(rule WCFG_WhileFalse)
with ‹l = 1› show ?thesis by simp blast
next
case False
with ‹1 ≤ l› have "2 ≤ l" by simp
then obtain l' where "l = l' + 2" and "l' = l - 2"
by(simp del:add_2_eq_Suc')
from ‹l = l' + 2› ‹l < #:while (b) prog'› have "l' < #:prog'" by simp
from IH[OF this] obtain n et
where "prog' ⊢ n -et→ (_ l' _) ∨ prog' ⊢ (_ l' _) -et→ n" by blast
thus ?thesis
proof
assume "prog' ⊢ n -et→ (_ l' _)"
show ?thesis
proof(cases "n = (_Entry_)")
case True
with ‹prog' ⊢ n -et→ (_ l' _)› have "l' = 0" by(auto dest:WCFG_EntryD)
have "while (b) prog' ⊢ (_0_) -(λs. interpret b s = Some true)⇩√→
(_0_) ⊕ 2"
by(rule WCFG_WhileTrue)
with ‹l' = 0› ‹l = l' + 2› show ?thesis by simp blast
next
case False
with ‹prog' ⊢ n -et→ (_ l' _)›
have "while (b) prog' ⊢ n ⊕ 2 -et→ (_ l' _) ⊕ 2"
by(fastforce intro:WCFG_WhileBody)
with ‹l = l' + 2› show ?thesis by simp blast
qed
next
assume "prog' ⊢ (_ l' _) -et→ n"
show ?thesis
proof(cases "n = (_Exit_)")
case True
with ‹prog' ⊢ (_ l' _) -et→ n›
have "while (b) prog' ⊢ (_ l' _) ⊕ 2 -et→ (_0_)"
by(fastforce intro:WCFG_WhileBodyExit)
with ‹l = l' + 2› show ?thesis by simp blast
next
case False
with ‹prog' ⊢ (_ l' _) -et→ n›
have "while (b) prog' ⊢ (_ l' _) ⊕ 2 -et→ n ⊕ 2"
by(fastforce intro:WCFG_WhileBody)
with ‹l = l' + 2› show ?thesis by simp blast
qed
qed
qed
qed
qed
declare One_nat_def [simp del]
lemma WCFG_deterministic:
"⟦prog ⊢ n⇩1 -et⇩1→ n⇩1'; prog ⊢ n⇩2 -et⇩2→ n⇩2'; n⇩1 = n⇩2; n⇩1' ≠ n⇩2'⟧
⟹ ∃Q Q'. et⇩1 = (Q)⇩√ ∧ et⇩2 = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
proof(induct arbitrary:n⇩2 n⇩2' rule:WCFG_induct)
case (WCFG_Entry_Exit prog)
from ‹prog ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_Entry_) = n⇩2› ‹(_Exit_) ≠ n⇩2'›
have "et⇩2 = (λs. True)⇩√" by(fastforce dest:WCFG_EntryD)
thus ?case by simp
next
case (WCFG_Entry prog)
from ‹prog ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_Entry_) = n⇩2› ‹(_0_) ≠ n⇩2'›
have "et⇩2 = (λs. False)⇩√" by(fastforce dest:WCFG_EntryD)
thus ?case by simp
next
case WCFG_Skip
from ‹Skip ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_0_) = n⇩2› ‹(_Exit_) ≠ n⇩2'›
have False by(fastforce elim:WCFG.While_CFG.cases)
thus ?case by simp
next
case (WCFG_LAss V e)
from ‹V:=e ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_0_) = n⇩2› ‹(_1_) ≠ n⇩2'›
have False by -(erule WCFG.While_CFG.cases,auto)
thus ?case by simp
next
case (WCFG_LAssSkip V e)
from ‹V:=e ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_1_) = n⇩2› ‹(_Exit_) ≠ n⇩2'›
have False by -(erule WCFG.While_CFG.cases,auto)
thus ?case by simp
next
case (WCFG_SeqFirst c⇩1 n et n' c⇩2)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩1 ⊢ n⇩2 -et⇩2→ n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = (Q)⇩√ ∧ et⇩2 = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹c⇩1;;c⇩2 ⊢ n⇩2 -et⇩2→ n⇩2'› ‹c⇩1 ⊢ n -et→ n'› ‹n = n⇩2› ‹n' ≠ n⇩2'›
have "c⇩1 ⊢ n⇩2 -et⇩2→ n⇩2' ∨ (c⇩1 ⊢ n⇩2 -et⇩2→ (_Exit_) ∧ n⇩2' = (_0_) ⊕ #:c⇩1)"
apply hypsubst_thin apply(erule WCFG.While_CFG.cases)
apply(auto intro:WCFG.While_CFG.intros)
by(case_tac n,auto dest:WCFG_sourcelabel_less_num_nodes)+
thus ?case
proof
assume "c⇩1 ⊢ n⇩2 -et⇩2→ n⇩2'"
from IH[OF this ‹n = n⇩2› ‹n' ≠ n⇩2'›] show ?case .
next
assume "c⇩1 ⊢ n⇩2 -et⇩2→ (_Exit_) ∧ n⇩2' = (_0_) ⊕ #:c⇩1"
hence edge:"c⇩1 ⊢ n⇩2 -et⇩2→ (_Exit_)" and n2':"n⇩2' = (_0_) ⊕ #:c⇩1" by simp_all
from IH[OF edge ‹n = n⇩2› ‹n' ≠ (_Exit_)›] show ?case .
qed
next
case (WCFG_SeqConnect c⇩1 n et c⇩2)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩1 ⊢ n⇩2 -et⇩2→ n⇩2'; n = n⇩2; (_Exit_) ≠ n⇩2'⟧
⟹ ∃Q Q'. et = (Q)⇩√ ∧ et⇩2 = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹c⇩1;;c⇩2 ⊢ n⇩2 -et⇩2→ n⇩2'› ‹c⇩1 ⊢ n -et→ (_Exit_)› ‹n = n⇩2› ‹n ≠ (_Entry_)›
‹(_0_) ⊕ #:c⇩1 ≠ n⇩2'› have "c⇩1 ⊢ n⇩2 -et⇩2→ n⇩2' ∧ (_Exit_) ≠ n⇩2'"
apply hypsubst_thin apply(erule WCFG.While_CFG.cases)
apply(auto intro:WCFG.While_CFG.intros)
by(case_tac n,auto dest:WCFG_sourcelabel_less_num_nodes)+
from IH[OF this[THEN conjunct1] ‹n = n⇩2› this[THEN conjunct2]]
show ?case .
next
case (WCFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩2 ⊢ n⇩2 -et⇩2→ n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = (Q)⇩√ ∧ et⇩2 = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹c⇩1;;c⇩2 ⊢ n⇩2 -et⇩2→ n⇩2'› ‹c⇩2 ⊢ n -et→ n'› ‹n ⊕ #:c⇩1 = n⇩2›
‹n' ⊕ #:c⇩1 ≠ n⇩2'› ‹n ≠ (_Entry_)›
obtain nx where "c⇩2 ⊢ n -et⇩2→ nx ∧ nx ⊕ #:c⇩1 = n⇩2'"
apply - apply(erule WCFG.While_CFG.cases)
apply(auto intro:WCFG.While_CFG.intros)
apply(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
apply(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
by(fastforce dest:label_incr_inj)
with ‹n' ⊕ #:c⇩1 ≠ n⇩2'› have edge:"c⇩2 ⊢ n -et⇩2→ nx" and neq:"n' ≠ nx"
by auto
from IH[OF edge _ neq] show ?case by simp
next
case (WCFG_CondTrue b c⇩1 c⇩2)
from ‹if (b) c⇩1 else c⇩2 ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_0_) = n⇩2› ‹(_0_) ⊕ 1 ≠ n⇩2'›
show ?case by -(erule WCFG.While_CFG.cases,auto)
next
case (WCFG_CondFalse b c⇩1 c⇩2)
from ‹if (b) c⇩1 else c⇩2 ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_0_) = n⇩2› ‹(_0_) ⊕ #:c⇩1 + 1 ≠ n⇩2'›
show ?case by -(erule WCFG.While_CFG.cases,auto)
next
case (WCFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩1 ⊢ n⇩2 -et⇩2→ n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = (Q)⇩√ ∧ et⇩2 = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹if (b) c⇩1 else c⇩2 ⊢ n⇩2 -et⇩2→ n⇩2'› ‹c⇩1 ⊢ n -et→ n'› ‹n ≠ (_Entry_)›
‹n ⊕ 1 = n⇩2› ‹n' ⊕ 1 ≠ n⇩2'›
obtain nx where "c⇩1 ⊢ n -et⇩2→ nx ∧ n' ≠ nx"
apply - apply(erule WCFG.While_CFG.cases)
apply(auto intro:WCFG.While_CFG.intros)
apply(drule label_incr_inj) apply auto
apply(drule label_incr_simp_rev[OF sym])
by(case_tac na,auto dest:WCFG_sourcelabel_less_num_nodes)
from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
case (WCFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c⇩2 ⊢ n⇩2 -et⇩2→ n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = (Q)⇩√ ∧ et⇩2 = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹if (b) c⇩1 else c⇩2 ⊢ n⇩2 -et⇩2→ n⇩2'› ‹c⇩2 ⊢ n -et→ n'› ‹n ≠ (_Entry_)›
‹n ⊕ #:c⇩1 + 1 = n⇩2› ‹n' ⊕ #:c⇩1 + 1 ≠ n⇩2'›
obtain nx where "c⇩2 ⊢ n -et⇩2→ nx ∧ n' ≠ nx"
apply - apply(erule WCFG.While_CFG.cases)
apply(auto intro:WCFG.While_CFG.intros)
apply(drule label_incr_simp_rev)
apply(case_tac na,auto,cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
by(fastforce dest:label_incr_inj)
from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
case (WCFG_WhileTrue b c')
from ‹while (b) c' ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_0_) = n⇩2› ‹(_0_) ⊕ 2 ≠ n⇩2'›
show ?case by -(erule WCFG.While_CFG.cases,auto)
next
case (WCFG_WhileFalse b c')
from ‹while (b) c' ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_0_) = n⇩2› ‹(_1_) ≠ n⇩2'›
show ?case by -(erule WCFG.While_CFG.cases,auto)
next
case (WCFG_WhileFalseSkip b c')
from ‹while (b) c' ⊢ n⇩2 -et⇩2→ n⇩2'› ‹(_1_) = n⇩2› ‹(_Exit_) ≠ n⇩2'›
show ?case by -(erule WCFG.While_CFG.cases,auto dest:label_incr_ge)
next
case (WCFG_WhileBody c' n et n' b)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c' ⊢ n⇩2 -et⇩2→ n⇩2'; n = n⇩2; n' ≠ n⇩2'⟧
⟹ ∃Q Q'. et = (Q)⇩√ ∧ et⇩2 = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹while (b) c' ⊢ n⇩2 -et⇩2→ n⇩2'› ‹c' ⊢ n -et→ n'› ‹n ≠ (_Entry_)›
‹n' ≠ (_Exit_)› ‹n ⊕ 2 = n⇩2› ‹n' ⊕ 2 ≠ n⇩2'›
obtain nx where "c' ⊢ n -et⇩2→ nx ∧ n' ≠ nx"
apply - apply(erule WCFG.While_CFG.cases)
apply(auto intro:WCFG.While_CFG.intros)
apply(fastforce dest:label_incr_ge[OF sym])
apply(fastforce dest:label_incr_inj)
by(fastforce dest:label_incr_inj)
from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
next
case (WCFG_WhileBodyExit c' n et b)
note IH = ‹⋀n⇩2 n⇩2'. ⟦c' ⊢ n⇩2 -et⇩2→ n⇩2'; n = n⇩2; (_Exit_) ≠ n⇩2'⟧
⟹ ∃Q Q'. et = (Q)⇩√ ∧ et⇩2 = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))›
from ‹while (b) c' ⊢ n⇩2 -et⇩2→ n⇩2'› ‹c' ⊢ n -et→ (_Exit_)› ‹n ≠ (_Entry_)›
‹n ⊕ 2 = n⇩2› ‹(_0_) ≠ n⇩2'›
obtain nx where "c' ⊢ n -et⇩2→ nx ∧ (_Exit_) ≠ nx"
apply - apply(erule WCFG.While_CFG.cases)
apply(auto intro:WCFG.While_CFG.intros)
apply(fastforce dest:label_incr_ge[OF sym])
by(fastforce dest:label_incr_inj)
from IH[OF this[THEN conjunct1] _ this[THEN conjunct2]] show ?case by simp
qed
declare One_nat_def [simp]
end
Theory Interpretation
section ‹Instantiate CFG locale with While CFG›
theory Interpretation imports
WCFG
"../Basic/CFGExit"
begin
subsection ‹Instatiation of the ‹CFG› locale›
abbreviation sourcenode :: "w_edge ⇒ w_node"
where "sourcenode e ≡ fst e"
abbreviation targetnode :: "w_edge ⇒ w_node"
where "targetnode e ≡ snd(snd e)"
abbreviation kind :: "w_edge ⇒ state edge_kind"
where "kind e ≡ fst(snd e)"
definition valid_edge :: "cmd ⇒ w_edge ⇒ bool"
where "valid_edge prog a ≡ prog ⊢ sourcenode a -kind a→ targetnode a"
definition valid_node ::"cmd ⇒ w_node ⇒ bool"
where "valid_node prog n ≡
(∃a. valid_edge prog a ∧ (n = sourcenode a ∨ n = targetnode a))"
lemma While_CFG_aux:
"CFG sourcenode targetnode (valid_edge prog) Entry"
proof(unfold_locales)
fix a assume "valid_edge prog a" and "targetnode a = (_Entry_)"
obtain nx et nx' where "a = (nx,et,nx')" by (cases a) auto
with ‹valid_edge prog a› ‹targetnode a = (_Entry_)›
have "prog ⊢ nx -et→ (_Entry_)" by(simp add:valid_edge_def)
thus False by fastforce
next
fix a a'
assume assms:"valid_edge prog a" "valid_edge prog a'"
"sourcenode a = sourcenode a'" "targetnode a = targetnode a'"
obtain x et y where [simp]:"a = (x,et,y)" by (cases a) auto
obtain x' et' y' where [simp]:"a' = (x',et',y')" by (cases a') auto
from assms have "et = et'"
by(fastforce intro:WCFG_edge_det simp:valid_edge_def)
with ‹sourcenode a = sourcenode a'› ‹targetnode a = targetnode a'›
show "a = a'" by simp
qed
interpretation While_CFG:
CFG sourcenode targetnode kind "valid_edge prog" Entry
for prog
by(rule While_CFG_aux)
lemma While_CFGExit_aux:
"CFGExit sourcenode targetnode kind (valid_edge prog) Entry Exit"
proof(unfold_locales)
fix a assume "valid_edge prog a" and "sourcenode a = (_Exit_)"
obtain nx et nx' where "a = (nx,et,nx')" by (cases a) auto
with ‹valid_edge prog a› ‹sourcenode a = (_Exit_)›
have "prog ⊢ (_Exit_) -et→ nx'" by(simp add:valid_edge_def)
thus False by fastforce
next
have "prog ⊢ (_Entry_) -(λs. False)⇩√→ (_Exit_)" by(rule WCFG_Entry_Exit)
thus "∃a. valid_edge prog a ∧ sourcenode a = (_Entry_) ∧
targetnode a = (_Exit_) ∧ kind a = (λs. False)⇩√"
by(fastforce simp:valid_edge_def)
qed
interpretation While_CFGExit:
CFGExit sourcenode targetnode kind "valid_edge prog" Entry Exit
for prog
by(rule While_CFGExit_aux)
end
Theory Labels
section ‹Labels›
theory Labels imports Com begin
text ‹Labels describe a mapping from the inner node label
to the matching command›
inductive labels :: "cmd ⇒ nat ⇒ cmd ⇒ bool"
where
Labels_Base:
"labels c 0 c"
| Labels_LAss:
"labels (V:=e) 1 Skip"
| Labels_Seq1:
"labels c⇩1 l c ⟹ labels (c⇩1;;c⇩2) l (c;;c⇩2)"
| Labels_Seq2:
"labels c⇩2 l c ⟹ labels (c⇩1;;c⇩2) (l + #:c⇩1) c"
| Labels_CondTrue:
"labels c⇩1 l c ⟹ labels (if (b) c⇩1 else c⇩2) (l + 1) c"
| Labels_CondFalse:
"labels c⇩2 l c ⟹ labels (if (b) c⇩1 else c⇩2) (l + #:c⇩1 + 1) c"
| Labels_WhileBody:
"labels c' l c ⟹ labels (while(b) c') (l + 2) (c;;while(b) c')"
| Labels_WhileExit:
"labels (while(b) c') 1 Skip"
lemma label_less_num_inner_nodes:
"labels c l c' ⟹ l < #:c"
proof(induct c arbitrary:l c')
case Skip
from ‹labels Skip l c'› show ?case by(fastforce elim:labels.cases)
next
case (LAss V e)
from ‹labels (V:=e) l c'› show ?case by(fastforce elim:labels.cases)
next
case (Seq c⇩1 c⇩2)
note IH1 = ‹⋀l c'. labels c⇩1 l c' ⟹ l < #:c⇩1›
note IH2 = ‹⋀l c'. labels c⇩2 l c' ⟹ l < #:c⇩2›
from ‹labels (c⇩1;;c⇩2) l c'› IH1 IH2 show ?case
by simp(erule labels.cases,auto,force)
next
case (Cond b c⇩1 c⇩2)
note IH1 = ‹⋀l c'. labels c⇩1 l c' ⟹ l < #:c⇩1›
note IH2 = ‹⋀l c'. labels c⇩2 l c' ⟹ l < #:c⇩2›
from ‹labels (if (b) c⇩1 else c⇩2) l c'› IH1 IH2 show ?case
by simp(erule labels.cases,auto,force)
next
case (While b c)
note IH = ‹⋀l c'. labels c l c' ⟹ l < #:c›
from ‹labels (while (b) c) l c'› IH show ?case
by simp(erule labels.cases,fastforce+)
qed
declare One_nat_def [simp del]
lemma less_num_inner_nodes_label:
"l < #:c ⟹ ∃c'. labels c l c'"
proof(induct c arbitrary:l)
case Skip
from ‹l < #:Skip› have "l = 0" by simp
thus ?case by(fastforce intro:Labels_Base)
next
case (LAss V e)
from ‹l < #:(V:=e)› have "l = 0 ∨ l = 1" by auto
thus ?case by(auto intro:Labels_Base Labels_LAss)
next
case (Seq c⇩1 c⇩2)
note IH1 = ‹⋀l. l < #:c⇩1 ⟹ ∃c'. labels c⇩1 l c'›
note IH2 = ‹⋀l. l < #:c⇩2 ⟹ ∃c'. labels c⇩2 l c'›
show ?case
proof(cases "l < #:c⇩1")
case True
from IH1[OF this] obtain c' where "labels c⇩1 l c'" by auto
hence "labels (c⇩1;;c⇩2) l (c';;c⇩2)" by(fastforce intro:Labels_Seq1)
thus ?thesis by auto
next
case False
hence "#:c⇩1 ≤ l" by simp
then obtain l' where "l = l' + #:c⇩1" and "l' = l - #:c⇩1" by simp
from ‹l = l' + #:c⇩1› ‹l < #:c⇩1;;c⇩2› have "l' < #:c⇩2" by simp
from IH2[OF this] obtain c' where "labels c⇩2 l' c'" by auto
with ‹l = l' + #:c⇩1› have "labels (c⇩1;;c⇩2) l c'" by(fastforce intro:Labels_Seq2)
thus ?thesis by auto
qed
next
case (Cond b c⇩1 c⇩2)
note IH1 = ‹⋀l. l < #:c⇩1 ⟹ ∃c'. labels c⇩1 l c'›
note IH2 = ‹⋀l. l < #:c⇩2 ⟹ ∃c'. labels c⇩2 l c'›
show ?case
proof(cases "l = 0")
case True
thus ?thesis by(fastforce intro:Labels_Base)
next
case False
hence "0 < l" by simp
then obtain l' where "l = l' + 1" and "l' = l - 1" by simp
thus ?thesis
proof(cases "l' < #:c⇩1")
case True
from IH1[OF this] obtain c' where "labels c⇩1 l' c'" by auto
with ‹l = l' + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce dest:Labels_CondTrue)
thus ?thesis by auto
next
case False
hence "#:c⇩1 ≤ l'" by simp
then obtain l'' where "l' = l'' + #:c⇩1" and "l'' = l' - #:c⇩1" by simp
from ‹l' = l'' + #:c⇩1› ‹l = l' + 1› ‹l < #:if (b) c⇩1 else c⇩2›
have "l'' < #:c⇩2" by simp
from IH2[OF this] obtain c' where "labels c⇩2 l'' c'" by auto
with ‹l' = l'' + #:c⇩1› ‹l = l' + 1› have "labels (if (b) c⇩1 else c⇩2) l c'"
by(fastforce dest:Labels_CondFalse)
thus ?thesis by auto
qed
qed
next
case (While b c')
note IH = ‹⋀l. l < #:c' ⟹ ∃c''. labels c' l c''›
show ?case
proof(cases "l < 1")
case True
hence "l = 0" by simp
thus ?thesis by(fastforce intro:Labels_Base)
next
case False
show ?thesis
proof(cases "l < 2")
case True
with ‹¬ l < 1› have "l = 1" by simp
thus ?thesis by(fastforce intro:Labels_WhileExit)
next
case False
with ‹¬ l < 1› have "2 ≤ l" by simp
then obtain l' where "l = l' + 2" and "l' = l - 2"
by(simp del:add_2_eq_Suc')
from ‹l = l' + 2› ‹l < #:while (b) c'› have "l' < #:c'" by simp
from IH[OF this] obtain c'' where "labels c' l' c''" by auto
with ‹l = l' + 2› have "labels (while (b) c') l (c'';;while (b) c')"
by(fastforce dest:Labels_WhileBody)
thus ?thesis by auto
qed
qed
qed
lemma labels_det:
"labels c l c'⟹ (⋀c''. labels c l c''⟹ c' = c'')"
proof(induct rule: labels.induct)
case (Labels_Base c c'')
from ‹labels c 0 c''› obtain l where "labels c l c''" and "l = 0" by auto
thus ?case by(induct rule: labels.induct,auto)
next
case (Labels_Seq1 c⇩1 l c c⇩2)
note IH = ‹⋀c''. labels c⇩1 l c'' ⟹ c = c''›
from ‹labels c⇩1 l c› have "l < #:c⇩1" by(fastforce intro:label_less_num_inner_nodes)
with ‹labels (c⇩1;;c⇩2) l c''› obtain cx where "c'' = cx;;c⇩2 ∧ labels c⇩1 l cx"
by(fastforce elim:labels.cases intro:Labels_Base)
hence [simp]:"c'' = cx;;c⇩2" and "labels c⇩1 l cx" by simp_all
from IH[OF ‹labels c⇩1 l cx›] show ?case by simp
next
case (Labels_Seq2 c⇩2 l c c⇩1)
note IH = ‹⋀c''. labels c⇩2 l c'' ⟹ c = c''›
from ‹labels (c⇩1;;c⇩2) (l + #:c⇩1) c''› ‹labels c⇩2 l c› have "labels c⇩2 l c''"
by(auto elim:labels.cases dest:label_less_num_inner_nodes)
from IH[OF this] show ?case .
next
case (Labels_CondTrue c⇩1 l c b c⇩2)
note IH = ‹⋀c''. labels c⇩1 l c'' ⟹ c = c''›
from ‹labels (if (b) c⇩1 else c⇩2) (l + 1) c''› ‹labels c⇩1 l c› have "labels c⇩1 l c''"
by(fastforce elim:labels.cases dest:label_less_num_inner_nodes)
from IH[OF this] show ?case .
next
case (Labels_CondFalse c⇩2 l c b c⇩1)
note IH = ‹⋀c''. labels c⇩2 l c'' ⟹ c = c''›
from ‹labels (if (b) c⇩1 else c⇩2) (l + #:c⇩1 + 1) c''› ‹labels c⇩2 l c›
have "labels c⇩2 l c''"
by(fastforce elim:labels.cases dest:label_less_num_inner_nodes)
from IH[OF this] show ?case .
next
case (Labels_WhileBody c' l c b)
note IH = ‹⋀c''. labels c' l c'' ⟹ c = c''›
from ‹labels (while (b) c') (l + 2) c''› ‹labels c' l c›
obtain cx where "c'' = cx;;while (b) c' ∧ labels c' l cx"
by -(erule labels.cases,auto)
hence [simp]:"c'' = cx;;while (b) c'" and "labels c' l cx" by simp_all
from IH[OF ‹labels c' l cx›] show ?case by simp
qed (fastforce elim:labels.cases)+
end
Theory WellFormed
section ‹General well-formedness of While CFG›
theory WellFormed imports
Interpretation
Labels
"../Basic/CFGExit_wf"
"../StaticIntra/CDepInstantiations"
begin
subsection ‹Definition of some functions›
fun lhs :: "cmd ⇒ vname set"
where
"lhs Skip = {}"
| "lhs (V:=e) = {V}"
| "lhs (c⇩1;;c⇩2) = lhs c⇩1"
| "lhs (if (b) c⇩1 else c⇩2) = {}"
| "lhs (while (b) c) = {}"
fun rhs_aux :: "expr ⇒ vname set"
where
"rhs_aux (Val v) = {}"
| "rhs_aux (Var V) = {V}"
| "rhs_aux (e1 «bop» e2) = (rhs_aux e1 ∪ rhs_aux e2)"
fun rhs :: "cmd ⇒ vname set"
where
"rhs Skip = {}"
| "rhs (V:=e) = rhs_aux e"
| "rhs (c⇩1;;c⇩2) = rhs c⇩1"
| "rhs (if (b) c⇩1 else c⇩2) = rhs_aux b"
| "rhs (while (b) c) = rhs_aux b"
lemma rhs_interpret_eq:
"⟦interpret b s = Some v'; ∀V ∈ rhs_aux b. s V = s' V⟧
⟹ interpret b s' = Some v'"
proof(induct b arbitrary:v')
case (Val v)
from ‹interpret (Val v) s = Some v'› have "v' = v" by(fastforce elim:interpret.cases)
thus ?case by simp
next
case (Var V)
hence "s' V = Some v'" by(fastforce elim:interpret.cases)
thus ?case by simp
next
case (BinOp b1 bop b2)
note IH1 = ‹⋀v'. ⟦interpret b1 s = Some v'; ∀V ∈ rhs_aux b1. s V = s' V⟧
⟹ interpret b1 s' = Some v'›
note IH2 = ‹⋀v'. ⟦interpret b2 s = Some v'; ∀V ∈ rhs_aux b2. s V = s' V⟧
⟹ interpret b2 s' = Some v'›
from ‹interpret (b1 «bop» b2) s = Some v'›
have "∃v⇩1 v⇩2. interpret b1 s = Some v⇩1 ∧ interpret b2 s = Some v⇩2 ∧
binop bop v⇩1 v⇩2 = Some v'"
apply(cases "interpret b1 s",simp)
apply(cases "interpret b2 s",simp)
by(case_tac "binop bop a aa",simp+)
then obtain v⇩1 v⇩2 where "interpret b1 s = Some v⇩1"
and "interpret b2 s = Some v⇩2" and "binop bop v⇩1 v⇩2 = Some v'" by blast
from ‹∀V ∈ rhs_aux (b1 «bop» b2). s V = s' V› have "∀V ∈ rhs_aux b1. s V = s' V"
by simp
from IH1[OF ‹interpret b1 s = Some v⇩1› this] have "interpret b1 s' = Some v⇩1" .
from ‹∀V ∈ rhs_aux (b1 «bop» b2). s V = s' V› have "∀V ∈ rhs_aux b2. s V = s' V"
by simp
from IH2[OF ‹interpret b2 s = Some v⇩2› this] have "interpret b2 s' = Some v⇩2" .
with ‹interpret b1 s' = Some v⇩1› ‹binop bop v⇩1 v⇩2 = Some v'› show ?case by simp
qed
fun Defs :: "cmd ⇒ w_node ⇒ vname set"
where "Defs prog n = {V. ∃l c. n = (_ l _) ∧ labels prog l c ∧ V ∈ lhs c}"
fun Uses :: "cmd ⇒ w_node ⇒ vname set"
where "Uses prog n = {V. ∃l c. n = (_ l _) ∧ labels prog l c ∧ V ∈ rhs c}"
subsection ‹Lemmas about @{term "prog ⊢ n -et→ n'"} to show well-formed
properties›
lemma WCFG_edge_no_Defs_equal:
"⟦prog ⊢ n -et→ n'; V ∉ Defs prog n⟧ ⟹ (transfer et s) V = s V"
proof(induct rule:WCFG_induct)
case (WCFG_LAss V' e)
have label:"labels (V':=e) 0 (V':=e)" and lhs:"V' ∈ lhs (V':=e)"
by(auto intro:Labels_Base)
hence "V' ∈ Defs (V':=e) (_0_)" by fastforce
with ‹V ∉ Defs (V':=e) (_0_)› show ?case by auto
next
case (WCFG_SeqFirst c⇩1 n et n' c⇩2)
note IH = ‹V ∉ Defs c⇩1 n ⟹ transfer et s V = s V›
have "V ∉ Defs c⇩1 n"
proof
assume "V ∈ Defs c⇩1 n"
then obtain c l where [simp]:"n = (_ l _)" and "labels c⇩1 l c"
and "V ∈ lhs c" by fastforce
from ‹labels c⇩1 l c› have "labels (c⇩1;;c⇩2) l (c;;c⇩2)"
by(fastforce intro:Labels_Seq1)
from ‹V ∈ lhs c› have "V ∈ lhs (c;;c⇩2)" by simp
with ‹labels (c⇩1;;c⇩2) l (c;;c⇩2)› have "V ∈ Defs (c⇩1;;c⇩2) n" by fastforce
with ‹V ∉ Defs (c⇩1;;c⇩2) n› show False by fastforce
qed
from IH[OF this] show ?case .
next
case (WCFG_SeqConnect c⇩1 n et c⇩2)
note IH = ‹V ∉ Defs c⇩1 n ⟹ transfer et s V = s V›
have "V ∉ Defs c⇩1 n"
proof
assume "V ∈ Defs c⇩1 n"
then obtain c l where [simp]:"n = (_ l _)" and "labels c⇩1 l c"
and "V ∈ lhs c" by fastforce
from ‹labels c⇩1 l c› have "labels (c⇩1;;c⇩2) l (c;;c⇩2)"
by(fastforce intro:Labels_Seq1)
from ‹V ∈ lhs c› have "V ∈ lhs (c;;c⇩2)" by simp
with ‹labels (c⇩1;;c⇩2) l (c;;c⇩2)› have "V ∈ Defs (c⇩1;;c⇩2) n" by fastforce
with ‹V ∉ Defs (c⇩1;;c⇩2) n› show False by fastforce
qed
from IH[OF this] show ?case .
next
case (WCFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹V ∉ Defs c⇩2 n ⟹ transfer et s V = s V›
have "V ∉ Defs c⇩2 n"
proof
assume "V ∈ Defs c⇩2 n"
then obtain c l where [simp]:"n = (_ l _)" and "labels c⇩2 l c"
and "V ∈ lhs c" by fastforce
from ‹labels c⇩2 l c› have "labels (c⇩1;;c⇩2) (l + #:c⇩1) c"
by(fastforce intro:Labels_Seq2)
with ‹V ∈ lhs c› have "V ∈ Defs (c⇩1;;c⇩2) (n ⊕ #:c⇩1)" by fastforce
with ‹V ∉ Defs (c⇩1;;c⇩2) (n ⊕ #:c⇩1)› show False by fastforce
qed
from IH[OF this] show ?case .
next
case (WCFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹V ∉ Defs c⇩1 n ⟹ transfer et s V = s V›
have "V ∉ Defs c⇩1 n"
proof
assume "V ∈ Defs c⇩1 n"
then obtain c l where [simp]:"n = (_ l _)" and "labels c⇩1 l c"
and "V ∈ lhs c" by fastforce
from ‹labels c⇩1 l c› have "labels (if (b) c⇩1 else c⇩2) (l + 1) c"
by(fastforce intro:Labels_CondTrue)
with ‹V ∈ lhs c› have "V ∈ Defs (if (b) c⇩1 else c⇩2) (n ⊕ 1)" by fastforce
with ‹V ∉ Defs (if (b) c⇩1 else c⇩2) (n ⊕ 1)› show False by fastforce
qed
from IH[OF this] show ?case .
next
case (WCFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹V ∉ Defs c⇩2 n ⟹ transfer et s V = s V›
have "V ∉ Defs c⇩2 n"
proof
assume "V ∈ Defs c⇩2 n"
then obtain c l where [simp]:"n = (_ l _)" and "labels c⇩2 l c"
and "V ∈ lhs c" by fastforce
from ‹labels c⇩2 l c› have "labels (if (b) c⇩1 else c⇩2) (l + #:c⇩1 + 1) c"
by(fastforce intro:Labels_CondFalse)
with ‹V ∈ lhs c› have "V ∈ Defs (if (b) c⇩1 else c⇩2) (n ⊕ #:c⇩1 + 1)"
by(fastforce simp:add.commute add.left_commute)
with ‹V ∉ Defs (if (b) c⇩1 else c⇩2) (n ⊕ #:c⇩1 + 1)› show False by fastforce
qed
from IH[OF this] show ?case .
next
case (WCFG_WhileBody c' n et n' b)
note IH = ‹V ∉ Defs c' n ⟹ transfer et s V = s V›
have "V ∉ Defs c' n"
proof
assume "V ∈ Defs c' n"
then obtain c l where [simp]:"n = (_ l _)" and "labels c' l c"
and "V ∈ lhs c" by fastforce
from ‹labels c' l c› have "labels (while (b) c') (l + 2) (c;;while (b) c')"
by(fastforce intro:Labels_WhileBody)
from ‹V ∈ lhs c› have "V ∈ lhs (c;;while (b) c')" by fastforce
with ‹labels (while (b) c') (l + 2) (c;;while (b) c')›
have "V ∈ Defs (while (b) c') (n ⊕ 2)" by fastforce
with ‹V ∉ Defs (while (b) c') (n ⊕ 2)› show False by fastforce
qed
from IH[OF this] show ?case .
next
case (WCFG_WhileBodyExit c' n et b)
note IH = ‹V ∉ Defs c' n ⟹ transfer et s V = s V›
have "V ∉ Defs c' n"
proof
assume "V ∈ Defs c' n"
then obtain c l where [simp]:"n = (_ l _)" and "labels c' l c"
and "V ∈ lhs c" by fastforce
from ‹labels c' l c› have "labels (while (b) c') (l + 2) (c;;while (b) c')"
by(fastforce intro:Labels_WhileBody)
from ‹V ∈ lhs c› have "V ∈ lhs (c;;while (b) c')" by fastforce
with ‹labels (while (b) c') (l + 2) (c;;while (b) c')›
have "V ∈ Defs (while (b) c') (n ⊕ 2)" by fastforce
with ‹V ∉ Defs (while (b) c') (n ⊕ 2)› show False by fastforce
qed
from IH[OF this] show ?case .
qed auto
declare One_nat_def [simp del]
lemma WCFG_edge_transfer_uses_only_Uses:
"⟦prog ⊢ n -et→ n'; ∀V ∈ Uses prog n. s V = s' V⟧
⟹ ∀V ∈ Defs prog n. (transfer et s) V = (transfer et s') V"
proof(induct rule:WCFG_induct)
case (WCFG_LAss V e)
have "Uses (V:=e) (_0_) = {V. V ∈ rhs_aux e}"
by(fastforce elim:labels.cases intro:Labels_Base)
with ‹∀V'∈Uses (V:=e) (_0_). s V' = s' V'›
have "∀V'∈rhs_aux e. s V' = s' V'" by blast
have "Defs (V:=e) (_0_) = {V}"
by(fastforce elim:labels.cases intro:Labels_Base)
have "transfer ⇑λs. s(V := interpret e s) s V =
transfer ⇑λs. s(V := interpret e s) s' V"
proof(cases "interpret e s")
case None
{ fix v assume "interpret e s' = Some v"
with ‹∀V'∈rhs_aux e. s V' = s' V'› have "interpret e s = Some v"
by(fastforce intro:rhs_interpret_eq)
with None have False by(fastforce split:if_split_asm) }
with None show ?thesis by fastforce
next
case (Some v)
hence "interpret e s = Some v" by(fastforce split:if_split_asm)
with ‹∀V'∈rhs_aux e. s V' = s' V'›
have "interpret e s' = Some v" by(fastforce intro:rhs_interpret_eq)
with Some show ?thesis by simp
qed
with ‹Defs (V:=e) (_0_) = {V}› show ?case by simp
next
case (WCFG_SeqFirst c⇩1 n et n' c⇩2)
note IH = ‹∀V∈Uses c⇩1 n. s V = s' V
⟹ ∀V∈Defs c⇩1 n. transfer et s V = transfer et s' V›
from ‹∀V∈Uses (c⇩1;;c⇩2) n. s V = s' V› have "∀V∈Uses c⇩1 n. s V = s' V"
by auto(drule Labels_Seq1[of _ _ _ c⇩2],erule_tac x="V" in allE,auto)
from IH[OF this] have "∀V∈Defs c⇩1 n. transfer et s V = transfer et s' V" .
with ‹c⇩1 ⊢ n -et→ n'› show ?case using Labels_Base
apply clarsimp
apply(erule labels.cases,auto dest:WCFG_sourcelabel_less_num_nodes)
by(erule_tac x="V" in allE,fastforce)
next
case (WCFG_SeqConnect c⇩1 n et c⇩2)
note IH = ‹∀V∈Uses c⇩1 n. s V = s' V
⟹ ∀V∈Defs c⇩1 n. transfer et s V = transfer et s' V›
from ‹∀V∈Uses (c⇩1;;c⇩2) n. s V = s' V› have "∀V∈Uses c⇩1 n. s V = s' V"
by auto(drule Labels_Seq1[of _ _ _ c⇩2],erule_tac x="V" in allE,auto)
from IH[OF this] have "∀V∈Defs c⇩1 n. transfer et s V = transfer et s' V" .
with ‹c⇩1 ⊢ n -et→ (_Exit_)› show ?case using Labels_Base
apply clarsimp
apply(erule labels.cases,auto dest:WCFG_sourcelabel_less_num_nodes)
by(erule_tac x="V" in allE,fastforce)
next
case (WCFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹∀V∈Uses c⇩2 n. s V = s' V
⟹ ∀V∈Defs c⇩2 n. transfer et s V = transfer et s' V›
from ‹∀V∈Uses (c⇩1;;c⇩2) (n ⊕ #:c⇩1). s V = s' V› have "∀V∈Uses c⇩2 n. s V = s' V"
by(auto,blast dest:Labels_Seq2)
from IH[OF this] have "∀V∈Defs c⇩2 n. transfer et s V = transfer et s' V" .
with num_inner_nodes_gr_0[of "c⇩1"] show ?case
apply clarsimp
apply(erule labels.cases,auto)
by(cases n,auto dest:label_less_num_inner_nodes)+
next
case (WCFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹∀V∈Uses c⇩1 n. s V = s' V
⟹ ∀V∈Defs c⇩1 n. transfer et s V = transfer et s' V›
from ‹∀V∈Uses (if (b) c⇩1 else c⇩2) (n ⊕ 1). s V = s' V›
have "∀V∈Uses c⇩1 n. s V = s' V" by(auto,blast dest:Labels_CondTrue)
from IH[OF this] have "∀V∈Defs c⇩1 n. transfer et s V = transfer et s' V" .
with ‹c⇩1 ⊢ n -et→ n'› show ?case
apply clarsimp
apply(erule labels.cases,auto)
apply(cases n,auto dest:label_less_num_inner_nodes)
by(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
next
case (WCFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹∀V∈Uses c⇩2 n. s V = s' V
⟹ ∀V∈Defs c⇩2 n. transfer et s V = transfer et s' V›
from ‹∀V∈Uses (if (b) c⇩1 else c⇩2) (n ⊕ #:c⇩1 + 1). s V = s' V›
have "∀V∈Uses c⇩2 n. s V = s' V"
by auto(drule Labels_CondFalse[of _ _ _ b c⇩1],erule_tac x="V" in allE,
auto simp:add.assoc)
from IH[OF this] have "∀V∈Defs c⇩2 n. transfer et s V = transfer et s' V" .
with ‹c⇩2 ⊢ n -et→ n'› show ?case
apply clarsimp
apply(erule labels.cases,auto)
apply(cases n,auto dest:label_less_num_inner_nodes)
by(cases n,auto dest:WCFG_sourcelabel_less_num_nodes)
next
case (WCFG_WhileBody c' n et n' b)
note IH = ‹∀V∈Uses c' n. s V = s' V
⟹ ∀V∈Defs c' n. transfer et s V = transfer et s' V›
from ‹∀V∈Uses (while (b) c') (n ⊕ 2). s V = s' V› have "∀V∈Uses c' n. s V = s' V"
by auto(drule Labels_WhileBody[of _ _ _ b],erule_tac x="V" in allE,auto)
from IH[OF this] have "∀V∈Defs c' n. transfer et s V = transfer et s' V" .
thus ?case
apply clarsimp
apply(erule labels.cases,auto)
by(cases n,auto dest:label_less_num_inner_nodes)
next
case (WCFG_WhileBodyExit c' n et b)
note IH = ‹∀V∈Uses c' n. s V = s' V
⟹ ∀V∈Defs c' n. transfer et s V = transfer et s' V›
from ‹∀V∈Uses (while (b) c') (n ⊕ 2). s V = s' V› have "∀V∈Uses c' n. s V = s' V"
by auto(drule Labels_WhileBody[of _ _ _ b],erule_tac x="V" in allE,auto)
from IH[OF this] have "∀V∈Defs c' n. transfer et s V = transfer et s' V" .
thus ?case
apply clarsimp
apply(erule labels.cases,auto)
by(cases n,auto dest:label_less_num_inner_nodes)
qed (fastforce elim:labels.cases)+
lemma WCFG_edge_Uses_pred_eq:
"⟦prog ⊢ n -et→ n'; ∀V ∈ Uses prog n. s V = s' V; pred et s⟧
⟹ pred et s'"
proof(induct rule:WCFG_induct)
case (WCFG_SeqFirst c⇩1 n et n' c⇩2)
note IH = ‹⟦∀V∈Uses c⇩1 n. s V = s' V; pred et s⟧ ⟹ pred et s'›
from ‹∀V∈Uses (c⇩1;; c⇩2) n. s V = s' V› have "∀V∈Uses c⇩1 n. s V = s' V"
by auto(drule Labels_Seq1[of _ _ _ c⇩2],erule_tac x="V" in allE,auto)
from IH[OF this ‹pred et s›] show ?case .
next
case (WCFG_SeqConnect c⇩1 n et c⇩2)
note IH = ‹⟦∀V∈Uses c⇩1 n. s V = s' V; pred et s⟧ ⟹ pred et s'›
from ‹∀V∈Uses (c⇩1;; c⇩2) n. s V = s' V› have "∀V∈Uses c⇩1 n. s V = s' V"
by auto(drule Labels_Seq1[of _ _ _ c⇩2],erule_tac x="V" in allE,auto)
from IH[OF this ‹pred et s›] show ?case .
next
case (WCFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹⟦∀V∈Uses c⇩2 n. s V = s' V; pred et s⟧ ⟹ pred et s'›
from ‹∀V∈Uses (c⇩1;; c⇩2) (n ⊕ #:c⇩1). s V = s' V›
have "∀V∈Uses c⇩2 n. s V = s' V" by(auto,blast dest:Labels_Seq2)
from IH[OF this ‹pred et s›] show ?case .
next
case (WCFG_CondTrue b c⇩1 c⇩2)
from ‹∀V∈Uses (if (b) c⇩1 else c⇩2) (_0_). s V = s' V›
have all:"∀V. labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2) ∧
V ∈ rhs (if (b) c⇩1 else c⇩2) ⟶ (s V = s' V)"
by fastforce
obtain v' where [simp]:"v' = true" by simp
with ‹pred (λs. interpret b s = Some true)⇩√ s›
have "interpret b s = Some v'" by simp
have "labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)" by(rule Labels_Base)
with all have "∀V ∈ rhs_aux b. s V = s' V" by simp
with ‹interpret b s = Some v'› have "interpret b s' = Some v'"
by(rule rhs_interpret_eq)
thus ?case by simp
next
case (WCFG_CondFalse b c⇩1 c⇩2)
from ‹∀V∈Uses (if (b) c⇩1 else c⇩2) (_0_). s V = s' V›
have all:"∀V. labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2) ∧
V ∈ rhs (if (b) c⇩1 else c⇩2) ⟶ (s V = s' V)"
by fastforce
obtain v' where [simp]:"v' = false" by simp
with ‹pred (λs. interpret b s = Some false)⇩√ s›
have "interpret b s = Some v'" by simp
have "labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)" by(rule Labels_Base)
with all have "∀V ∈ rhs_aux b. s V = s' V" by simp
with ‹interpret b s = Some v'› have "interpret b s' = Some v'"
by(rule rhs_interpret_eq)
thus ?case by simp
next
case (WCFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹⟦∀V∈Uses c⇩1 n. s V = s' V; pred et s⟧ ⟹ pred et s'›
from ‹∀V∈Uses (if (b) c⇩1 else c⇩2) (n ⊕ 1). s V = s' V›
have "∀V∈Uses c⇩1 n. s V = s' V" by(auto,blast dest:Labels_CondTrue)
from IH[OF this ‹pred et s›] show ?case .
next
case (WCFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹⟦∀V∈Uses c⇩2 n. s V = s' V; pred et s⟧ ⟹ pred et s'›
from ‹∀V∈Uses (if (b) c⇩1 else c⇩2) (n ⊕ #:c⇩1 + 1). s V = s' V›
have "∀V∈Uses c⇩2 n. s V = s' V"
by auto(drule Labels_CondFalse[of _ _ _ b c⇩1],erule_tac x="V" in allE,
auto simp:add.assoc)
from IH[OF this ‹pred et s›] show ?case .
next
case (WCFG_WhileTrue b c')
from ‹∀V∈Uses (while (b) c') (_0_). s V = s' V›
have all:"∀V. labels (while (b) c') 0 (while (b) c') ∧
V ∈ rhs (while (b) c') ⟶ (s V = s' V)"
by fastforce
obtain v' where [simp]:"v' = true" by simp
with ‹pred (λs. interpret b s = Some true)⇩√ s›
have "interpret b s = Some v'" by simp
have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
with all have "∀V ∈ rhs_aux b. s V = s' V" by simp
with ‹interpret b s = Some v'› have "interpret b s' = Some v'"
by(rule rhs_interpret_eq)
thus ?case by simp
next
case (WCFG_WhileFalse b c')
from ‹∀V∈Uses (while (b) c') (_0_). s V = s' V›
have all:"∀V. labels (while (b) c') 0 (while (b) c') ∧
V ∈ rhs (while (b) c') ⟶ (s V = s' V)"
by fastforce
obtain v' where [simp]:"v' = false" by simp
with ‹pred (λs. interpret b s = Some false)⇩√ s›
have "interpret b s = Some v'" by simp
have "labels (while (b) c') 0 (while (b) c')" by(rule Labels_Base)
with all have "∀V ∈ rhs_aux b. s V = s' V" by simp
with ‹interpret b s = Some v'› have "interpret b s' = Some v'"
by(rule rhs_interpret_eq)
thus ?case by simp
next
case (WCFG_WhileBody c' n et n' b)
note IH = ‹⟦∀V∈Uses c' n. s V = s' V; pred et s⟧ ⟹ pred et s'›
from ‹∀V∈Uses (while (b) c') (n ⊕ 2). s V = s' V› have "∀V∈Uses c' n. s V = s' V"
by auto(drule Labels_WhileBody[of _ _ _ b],erule_tac x="V" in allE,auto)
from IH[OF this ‹pred et s›] show ?case .
next
case (WCFG_WhileBodyExit c' n et b)
note IH = ‹⟦∀V∈Uses c' n. s V = s' V; pred et s⟧ ⟹ pred et s'›
from ‹∀V∈Uses (while (b) c') (n ⊕ 2). s V = s' V› have "∀V∈Uses c' n. s V = s' V"
by auto(drule Labels_WhileBody[of _ _ _ b],erule_tac x="V" in allE,auto)
from IH[OF this ‹pred et s›] show ?case .
qed simp_all
declare One_nat_def [simp]
interpretation While_CFG_wf: CFG_wf sourcenode targetnode kind
"valid_edge prog" Entry "Defs prog" "Uses prog" id
for prog
proof(unfold_locales)
show "Defs prog (_Entry_) = {} ∧ Uses prog (_Entry_) = {}"
by(simp add:Defs.simps Uses.simps)
next
fix a V s
assume "valid_edge prog a" and "V ∉ Defs prog (sourcenode a)"
obtain nx et nx' where [simp]:"a = (nx,et,nx')" by(cases a) auto
with ‹valid_edge prog a› have "prog ⊢ nx -et→ nx'" by(simp add:valid_edge_def)
with ‹V ∉ Defs prog (sourcenode a)› show "id (transfer (kind a) s) V = id s V"
by(fastforce intro:WCFG_edge_no_Defs_equal)
next
fix a fix s s'::state
assume "valid_edge prog a"
and "∀V∈Uses prog (sourcenode a). id s V = id s' V"
obtain nx et nx' where [simp]:"a = (nx,et,nx')" by(cases a) auto
with ‹valid_edge prog a› have "prog ⊢ nx -et→ nx'" by(simp add:valid_edge_def)
with ‹∀V∈Uses prog (sourcenode a). id s V = id s' V›
show "∀V∈Defs prog (sourcenode a).
id (transfer (kind a) s) V = id (transfer (kind a) s') V"
by -(drule WCFG_edge_transfer_uses_only_Uses,simp+)
next
fix a s s'
assume pred:"pred (kind a) s" and valid:"valid_edge prog a"
and all:"∀V∈Uses prog (sourcenode a). id s V = id s' V"
obtain nx et nx' where [simp]:"a = (nx,et,nx')" by(cases a) auto
with ‹valid_edge prog a› have "prog ⊢ nx -et→ nx'" by(simp add:valid_edge_def)
with ‹pred (kind a) s› ‹∀V∈Uses prog (sourcenode a). id s V = id s' V›
show "pred (kind a) s'" by -(drule WCFG_edge_Uses_pred_eq,simp+)
next
fix a a'
assume "valid_edge prog a" and "valid_edge prog a'"
and "sourcenode a = sourcenode a'" and "targetnode a ≠ targetnode a'"
thus "∃Q Q'. kind a = (Q)⇩√ ∧ kind a' = (Q')⇩√ ∧
(∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
by(fastforce intro!:WCFG_deterministic simp:valid_edge_def)
qed
lemma While_CFGExit_wf_aux:"CFGExit_wf sourcenode targetnode kind
(valid_edge prog) Entry (Defs prog) (Uses prog) id Exit"
proof(unfold_locales)
show "Defs prog (_Exit_) = {} ∧ Uses prog (_Exit_) = {}"
by(simp add:Defs.simps Uses.simps)
qed
interpretation While_CFGExit_wf: CFGExit_wf sourcenode targetnode kind
"valid_edge prog" Entry "Defs prog" "Uses prog" id Exit
for prog
by(rule While_CFGExit_wf_aux)
end
Theory AdditionalLemmas
section ‹Lemmas for the control dependences›
theory AdditionalLemmas imports WellFormed
begin
subsection ‹Paths to @{term "(_Exit_)"} and from @{term "(_Entry_)"} exist›
abbreviation path :: "cmd ⇒ w_node ⇒ w_edge list ⇒ w_node ⇒ bool"
("_ ⊢ _ -_→* _")
where "prog ⊢ n -as→* n' ≡ CFG.path sourcenode targetnode (valid_edge prog)
n as n'"
definition label_incrs :: "w_edge list ⇒ nat ⇒ w_edge list" ("_ ⊕s _" 60)
where "as ⊕s i ≡ map (λ(n,et,n'). (n ⊕ i,et,n' ⊕ i)) as"
lemma path_SeqFirst:
"prog ⊢ n -as→* (_ l _) ⟹ prog;;c⇩2 ⊢ n -as→* (_ l _)"
proof(induct n as "(_ l _)" arbitrary:l rule:While_CFG.path.induct)
case empty_path
from ‹CFG.valid_node sourcenode targetnode (valid_edge prog) (_ l _)›
show ?case
apply -
apply(rule While_CFG.empty_path)
apply(auto simp:While_CFG.valid_node_def valid_edge_def)
by(case_tac b,auto dest:WCFG_SeqFirst WCFG_SeqConnect)
next
case (Cons_path n'' as a n)
note IH = ‹prog;; c⇩2 ⊢ n'' -as→* (_ l _)›
from ‹prog ⊢ n'' -as→* (_ l _)› have "n'' ≠ (_Exit_)"
by fastforce
with ‹valid_edge prog a› ‹sourcenode a = n› ‹targetnode a = n''›
have "prog;;c⇩2 ⊢ n -kind a→ n''" by(simp add:valid_edge_def WCFG_SeqFirst)
with IH ‹prog;;c⇩2 ⊢ n -kind a→ n''› ‹sourcenode a = n› ‹targetnode a = n''› show ?case
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
qed
lemma path_SeqSecond:
"⟦prog ⊢ n -as→* n'; n ≠ (_Entry_); as ≠ []⟧
⟹ c⇩1;;prog ⊢ n ⊕ #:c⇩1 -as ⊕s #:c⇩1→* n' ⊕ #:c⇩1"
proof(induct rule:While_CFG.path.induct)
case (Cons_path n'' as n' a n)
note IH = ‹ ⟦n'' ≠ (_Entry_); as ≠ []⟧
⟹ c⇩1;;prog ⊢ n'' ⊕ #:c⇩1 -as ⊕s #:c⇩1→* n' ⊕ #:c⇩1›
from ‹valid_edge prog a› ‹sourcenode a = n› ‹targetnode a = n''› ‹n ≠ (_Entry_)›
have "c⇩1;;prog ⊢ n ⊕ #:c⇩1 -kind a→ n'' ⊕ #:c⇩1"
by(simp add:valid_edge_def WCFG_SeqSecond)
from ‹sourcenode a = n› ‹targetnode a = n''› ‹valid_edge prog a›
have "[(n,kind a,n'')] ⊕s #:c⇩1 = [a] ⊕s #:c⇩1"
by(cases a,simp add:label_incrs_def valid_edge_def)
show ?case
proof(cases "as = []")
case True
with ‹prog ⊢ n'' -as→* n'› have [simp]:"n'' = n'" by(auto elim:While_CFG.cases)
with ‹c⇩1;;prog ⊢ n ⊕ #:c⇩1 -kind a→ n'' ⊕ #:c⇩1›
have "c⇩1;;prog ⊢ n ⊕ #:c⇩1 -[(n,kind a,n')] ⊕s #:c⇩1→* n' ⊕ #:c⇩1"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:label_incrs_def While_CFG.valid_node_def valid_edge_def)
with True ‹[(n,kind a,n'')] ⊕s #:c⇩1 = [a] ⊕s #:c⇩1› show ?thesis by simp
next
case False
from ‹valid_edge prog a› ‹targetnode a = n''› have "n'' ≠ (_Entry_)"
by(cases n'',auto simp:valid_edge_def)
from IH[OF this False]
have "c⇩1;;prog ⊢ n'' ⊕ #:c⇩1 -as ⊕s #:c⇩1→* n' ⊕ #:c⇩1" .
with ‹c⇩1;;prog ⊢ n ⊕ #:c⇩1 -kind a→ n'' ⊕ #:c⇩1› ‹sourcenode a = n›
‹targetnode a = n''› ‹[(n,kind a,n'')] ⊕s #:c⇩1 = [a] ⊕s #:c⇩1› show ?thesis
apply(cases a)
apply(simp add:label_incrs_def)
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
qed
qed simp
lemma path_CondTrue:
"prog ⊢ (_ l _) -as→* n'
⟹ if (b) prog else c⇩2 ⊢ (_ l _) ⊕ 1 -as ⊕s 1→* n' ⊕ 1"
proof(induct "(_ l _)" as n' arbitrary:l rule:While_CFG.path.induct)
case empty_path
from ‹CFG.valid_node sourcenode targetnode (valid_edge prog) (_ l _)›
WCFG_CondTrue[of b prog c⇩2]
have "CFG.valid_node sourcenode targetnode (valid_edge (if (b) prog else c⇩2))
((_ l _) ⊕ 1)"
apply(auto simp:While_CFG.valid_node_def valid_edge_def)
apply(rotate_tac 1,drule WCFG_CondThen,simp,fastforce)
apply(case_tac a) apply auto
apply(rotate_tac 1,drule WCFG_CondThen,simp,fastforce)
by(rotate_tac 1,drule WCFG_EntryD,auto)
then show ?case
by(fastforce intro:While_CFG.empty_path simp:label_incrs_def)
next
case (Cons_path n'' as n' a)
note IH = ‹⋀l. n'' = (_ l _)
⟹ if (b) prog else c⇩2 ⊢ (_ l _) ⊕ 1 -as ⊕s 1→* n' ⊕ 1›
from ‹valid_edge prog a› ‹sourcenode a = (_ l _)› ‹targetnode a = n''›
have "if (b) prog else c⇩2 ⊢ (_ l _) ⊕ 1 -kind a→ n'' ⊕ 1"
by -(rule WCFG_CondThen,simp_all add:valid_edge_def)
from ‹sourcenode a = (_ l _)› ‹targetnode a = n''› ‹valid_edge prog a›
have "[((_ l _),kind a,n'')] ⊕s 1 = [a] ⊕s 1"
by(cases a,simp add:label_incrs_def valid_edge_def)
show ?case
proof(cases n'')
case (Node l')
from IH[OF this] have "if (b) prog else c⇩2 ⊢ (_ l' _) ⊕ 1 -as ⊕s 1→* n' ⊕ 1" .
with ‹if (b) prog else c⇩2 ⊢ (_ l _) ⊕ 1 -kind a→ n'' ⊕ 1› Node
have "if (b) prog else c⇩2 ⊢ (_ l _) ⊕ 1 -((_ l _) ⊕ 1,kind a,n'' ⊕ 1)#(as ⊕s 1)→* n' ⊕ 1"
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def valid_node_def)
with ‹[((_ l _),kind a,n'')] ⊕s 1 = [a] ⊕s 1›
have "if (b) prog else c⇩2 ⊢ (_ l _) ⊕ 1 -a#as ⊕s 1→* n' ⊕ 1"
by(simp add:label_incrs_def)
thus ?thesis by simp
next
case Entry
with ‹valid_edge prog a› ‹targetnode a = n''› have False by fastforce
thus ?thesis by simp
next
case Exit
with ‹prog ⊢ n'' -as→* n'› have "n' = (_Exit_)" and "as = []"
by(auto dest:While_CFGExit.path_Exit_source)
from ‹if (b) prog else c⇩2 ⊢ (_ l _) ⊕ 1 -kind a→ n'' ⊕ 1›
have "if (b) prog else c⇩2 ⊢ (_ l _) ⊕ 1 -[((_ l _) ⊕ 1,kind a,n'' ⊕ 1)]→* n'' ⊕ 1"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:While_CFG.valid_node_def valid_edge_def)
with Exit ‹[((_ l _),kind a,n'')] ⊕s 1 = [a] ⊕s 1› ‹n' = (_Exit_)› ‹as = []›
show ?thesis by(fastforce simp:label_incrs_def)
qed
qed
lemma path_CondFalse:
"prog ⊢ (_ l _) -as→* n'
⟹ if (b) c⇩1 else prog ⊢ (_ l _) ⊕ (#:c⇩1 + 1) -as ⊕s (#:c⇩1 + 1)→* n' ⊕ (#:c⇩1 + 1)"
proof(induct "(_ l _)" as n' arbitrary:l rule:While_CFG.path.induct)
case empty_path
from ‹CFG.valid_node sourcenode targetnode (valid_edge prog) (_ l _)›
WCFG_CondFalse[of b c⇩1 prog]
have "CFG.valid_node sourcenode targetnode (valid_edge (if (b) c⇩1 else prog))
((_ l _) ⊕ #:c⇩1 + 1)"
apply(auto simp:While_CFG.valid_node_def valid_edge_def)
apply(rotate_tac 1,drule WCFG_CondElse,simp,fastforce)
apply(case_tac a) apply auto
apply(rotate_tac 1,drule WCFG_CondElse,simp,fastforce)
by(rotate_tac 1,drule WCFG_EntryD,auto)
thus ?case by(fastforce intro:While_CFG.empty_path simp:label_incrs_def)
next
case (Cons_path n'' as n' a)
note IH = ‹⋀l. n'' = (_ l _) ⟹ if (b) c⇩1 else prog ⊢ (_ l _) ⊕ (#:c⇩1 + 1)
-as ⊕s (#:c⇩1 + 1)→* n' ⊕ (#:c⇩1 + 1)›
from ‹valid_edge prog a› ‹sourcenode a = (_ l _)› ‹targetnode a = n''›
have "if (b) c⇩1 else prog ⊢ (_ l _) ⊕ (#:c⇩1 + 1) -kind a→ n'' ⊕ (#:c⇩1 + 1)"
by -(rule WCFG_CondElse,simp_all add:valid_edge_def)
from ‹sourcenode a = (_ l _)› ‹targetnode a = n''› ‹valid_edge prog a›
have "[((_ l _),kind a,n'')] ⊕s (#:c⇩1 + 1) = [a] ⊕s (#:c⇩1 + 1)"
by(cases a,simp add:label_incrs_def valid_edge_def)
show ?case
proof(cases n'')
case (Node l')
from IH[OF this] have "if (b) c⇩1 else prog ⊢ (_ l' _) ⊕ (#:c⇩1 + 1)
-as ⊕s (#:c⇩1 + 1)→* n' ⊕ (#:c⇩1 + 1)" .
with ‹if (b) c⇩1 else prog ⊢ (_ l _) ⊕ (#:c⇩1 + 1) -kind a→ n'' ⊕ (#:c⇩1 + 1)› Node
have "if (b) c⇩1 else prog ⊢ (_ l _) ⊕ (#:c⇩1 + 1)
-((_ l _) ⊕ (#:c⇩1 + 1),kind a,n'' ⊕ (#:c⇩1 + 1))#(as ⊕s (#:c⇩1 + 1))→*
n' ⊕ (#:c⇩1 + 1)"
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def valid_node_def)
with ‹[((_ l _),kind a,n'')] ⊕s (#:c⇩1 + 1) = [a] ⊕s (#:c⇩1 + 1)› Node
have "if (b) c⇩1 else prog ⊢ (_ l _) ⊕ (#:c⇩1 + 1) -a#as ⊕s (#:c⇩1 + 1)→*
n' ⊕ (#:c⇩1 + 1)"
by(simp add:label_incrs_def)
thus ?thesis by simp
next
case Entry
with ‹valid_edge prog a› ‹targetnode a = n''› have False by fastforce
thus ?thesis by simp
next
case Exit
with ‹prog ⊢ n'' -as→* n'› have "n' = (_Exit_)" and "as = []"
by(auto dest:While_CFGExit.path_Exit_source)
from ‹if (b) c⇩1 else prog ⊢ (_ l _) ⊕ (#:c⇩1 + 1) -kind a→ n'' ⊕ (#:c⇩1 + 1)›
have "if (b) c⇩1 else prog ⊢ (_ l _) ⊕ (#:c⇩1 + 1)
-[((_ l _) ⊕ (#:c⇩1 + 1),kind a,n'' ⊕ (#:c⇩1 + 1))]→* n'' ⊕ (#:c⇩1 + 1)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:While_CFG.valid_node_def valid_edge_def)
with Exit ‹[((_ l _),kind a,n'')] ⊕s (#:c⇩1 + 1) = [a] ⊕s (#:c⇩1 + 1)› ‹n' = (_Exit_)›
‹as = []›
show ?thesis by(fastforce simp:label_incrs_def)
qed
qed
declare add_2_eq_Suc' [simp del] One_nat_def [simp del]
lemma path_While:
"prog ⊢ (_ l _) -as→* (_ l' _)
⟹ while (b) prog ⊢ (_ l _) ⊕ 2 -as ⊕s 2→* (_ l' _) ⊕ 2"
proof(induct "(_ l _)" as "(_ l' _)" arbitrary:l l' rule:While_CFG.path.induct)
case empty_path
from ‹CFG.valid_node sourcenode targetnode (valid_edge prog) (_ l _)›
WCFG_WhileTrue[of b prog]
have "CFG.valid_node sourcenode targetnode (valid_edge (while (b) prog)) ((_ l _) ⊕ 2)"
apply(auto simp:While_CFG.valid_node_def valid_edge_def)
apply(case_tac ba) apply auto
apply(rotate_tac 1,drule WCFG_WhileBody,auto)
apply(rotate_tac 1,drule WCFG_WhileBodyExit,auto)
apply(case_tac a) apply auto
apply(rotate_tac 1,drule WCFG_WhileBody,auto)
by(rotate_tac 1,drule WCFG_EntryD,auto)
thus ?case by(fastforce intro:While_CFG.empty_path simp:label_incrs_def)
next
case (Cons_path n'' as a)
note IH = ‹⋀l. n'' = (_ l _)
⟹ while (b) prog ⊢ (_ l _) ⊕ 2 -as ⊕s 2→* (_ l' _) ⊕ 2›
from ‹sourcenode a = (_ l _)› ‹targetnode a = n''› ‹valid_edge prog a›
have "[((_ l _),kind a,n'')] ⊕s 2 = [a] ⊕s 2"
by(cases a,simp add:label_incrs_def valid_edge_def)
show ?case
proof(cases n'')
case (Node l'')
with ‹valid_edge prog a› ‹sourcenode a = (_ l _)› ‹targetnode a = n''›
have "while (b) prog ⊢ (_ l _) ⊕ 2 -kind a→ n'' ⊕ 2"
by -(rule WCFG_WhileBody,simp_all add:valid_edge_def)
from IH[OF Node]
have "while (b) prog ⊢ (_ l'' _) ⊕ 2 -as ⊕s 2→* (_ l' _) ⊕ 2" .
with ‹while (b) prog ⊢ (_ l _) ⊕ 2 -kind a→ n'' ⊕ 2› Node
have "while (b) prog ⊢ (_ l _) ⊕ 2 -((_ l _) ⊕ 2,kind a,n'' ⊕ 2)#(as ⊕s 2)→* (_ l' _) ⊕ 2"
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
with ‹[((_ l _),kind a,n'')] ⊕s 2 = [a] ⊕s 2› show ?thesis by(simp add:label_incrs_def)
next
case Entry
with ‹valid_edge prog a› ‹targetnode a = n''› have False by fastforce
thus ?thesis by simp
next
case Exit
with ‹prog ⊢ n'' -as→* (_ l' _)› have "(_ l' _) = (_Exit_)" and "as = []"
by(auto dest:While_CFGExit.path_Exit_source)
then have False by simp
thus ?thesis by simp
qed
qed
lemma inner_node_Entry_Exit_path:
"l < #:prog ⟹ (∃as. prog ⊢ (_ l _) -as→* (_Exit_)) ∧
(∃as. prog ⊢ (_Entry_) -as→* (_ l _))"
proof(induct prog arbitrary:l)
case Skip
from ‹l < #:Skip› have [simp]:"l = 0" by simp
hence "Skip ⊢ (_ l _) -⇑id→ (_Exit_)" by(simp add:WCFG_Skip)
hence "Skip ⊢ (_ l _) -[((_ l _),⇑id,(_Exit_))]→* (_Exit_)"
by (fastforce intro: While_CFG.path.intros simp: valid_edge_def)
have "Skip ⊢ (_Entry_) -(λs. True)⇩√→ (_ l _)" by(simp add:WCFG_Entry)
hence "Skip ⊢ (_Entry_) -[((_Entry_),(λs. True)⇩√,(_ l _))]→* (_ l _)"
by(fastforce intro:While_CFG.path.intros simp:valid_edge_def While_CFG.valid_node_def)
with ‹Skip ⊢ (_ l _) -[((_ l _),⇑id,(_Exit_))]→* (_Exit_)› show ?case by fastforce
next
case (LAss V e)
from ‹l < #:V:=e› have "l = 0 ∨ l = 1" by auto
thus ?case
proof
assume [simp]:"l = 0"
hence "V:=e ⊢ (_Entry_) -(λs. True)⇩√→ (_ l _)" by(simp add:WCFG_Entry)
hence "V:=e ⊢ (_Entry_) -[((_Entry_),(λs. True)⇩√,(_ l _))]→* (_ l _)"
by(fastforce intro:While_CFG.path.intros simp:valid_edge_def While_CFG.valid_node_def)
have "V:=e ⊢ (_1_) -⇑id→ (_Exit_)" by(rule WCFG_LAssSkip)
hence "V:=e ⊢ (_1_) -[((_1_),⇑id,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.path.intros simp:valid_edge_def)
with WCFG_LAss have "V:=e ⊢ (_ l _) -
[((_ l _),⇑(λs. s(V:=(interpret e s))),(_1_)),((_1_),⇑id,(_Exit_))]→*
(_Exit_)"
by(fastforce intro:While_CFG.path.intros simp:valid_edge_def)
with ‹V:=e ⊢ (_Entry_) -[((_Entry_),(λs. True)⇩√,(_ l _))]→* (_ l _)›
show ?case by fastforce
next
assume [simp]:"l = 1"
hence "V:=e ⊢ (_ l _) -⇑id→ (_Exit_)" by(simp add:WCFG_LAssSkip)
hence "V:=e ⊢ (_ l _) -[((_ l _),⇑id,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.path.intros simp:valid_edge_def)
have "V:=e ⊢ (_0_) -⇑(λs. s(V:=(interpret e s)))→ (_ l _)"
by(simp add:WCFG_LAss)
hence "V:=e ⊢ (_0_) -[((_0_),⇑(λs. s(V:=(interpret e s))),(_ l _))]→* (_ l _)"
by(fastforce intro:While_CFG.path.intros simp:valid_edge_def While_CFG.valid_node_def)
with WCFG_Entry[of "V:=e"] have "V:=e ⊢ (_Entry_) -[((_Entry_),(λs. True)⇩√,(_0_))
,((_0_),⇑(λs. s(V:=(interpret e s))),(_ l _))]→* (_ l _)"
by(fastforce intro:While_CFG.path.intros simp:valid_edge_def)
with ‹V:=e ⊢ (_ l _) -[((_ l _),⇑id,(_Exit_))]→* (_Exit_)› show ?case by fastforce
qed
next
case (Seq prog1 prog2)
note IH1 = ‹⋀l. l < #:prog1 ⟹
(∃as. prog1 ⊢ (_ l _) -as→* (_Exit_)) ∧ (∃as. prog1 ⊢ (_Entry_) -as→* (_ l _))›
note IH2 = ‹⋀l. l < #:prog2 ⟹
(∃as. prog2 ⊢ (_ l _) -as→* (_Exit_)) ∧ (∃as. prog2 ⊢ (_Entry_) -as→* (_ l _))›
show ?case
proof(cases "l < #:prog1")
case True
from IH1[OF True] obtain as as' where "prog1 ⊢ (_ l _) -as→* (_Exit_)"
and "prog1 ⊢ (_Entry_) -as'→* (_ l _)" by blast
from ‹prog1 ⊢ (_Entry_) -as'→* (_ l _)›
have "prog1;;prog2 ⊢ (_Entry_) -as'→* (_ l _)"
by(fastforce intro:path_SeqFirst)
from ‹prog1 ⊢ (_ l _) -as→* (_Exit_)›
obtain asx ax where "prog1 ⊢ (_ l _) -asx@[ax]→* (_Exit_)"
by(induct rule:rev_induct,auto elim:While_CFG.path.cases)
hence "prog1 ⊢ (_ l _) -asx→* sourcenode ax"
and "valid_edge prog1 ax" and "(_Exit_) = targetnode ax"
by(auto intro:While_CFG.path_split_snoc)
from ‹prog1 ⊢ (_ l _) -asx→* sourcenode ax› ‹valid_edge prog1 ax›
obtain lx where [simp]:"sourcenode ax = (_ lx _)"
by(cases "sourcenode ax") auto
with ‹prog1 ⊢ (_ l _) -asx→* sourcenode ax›
have "prog1;;prog2 ⊢ (_ l _) -asx→* sourcenode ax"
by(fastforce intro:path_SeqFirst)
from ‹valid_edge prog1 ax› ‹(_Exit_) = targetnode ax›
have "prog1;;prog2 ⊢ sourcenode ax -kind ax→ (_0_) ⊕ #:prog1"
by(fastforce intro:WCFG_SeqConnect simp:valid_edge_def)
hence "prog1;;prog2 ⊢ sourcenode ax -[(sourcenode ax,kind ax,(_0_) ⊕ #:prog1)]→*
(_0_) ⊕ #:prog1"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:While_CFG.valid_node_def valid_edge_def)
with ‹prog1;;prog2 ⊢ (_ l _) -asx→* sourcenode ax›
have "prog1;;prog2 ⊢ (_ l _) -asx@[(sourcenode ax,kind ax,(_0_) ⊕ #:prog1)]→*
(_0_) ⊕ #:prog1"
by(fastforce intro:While_CFG.path_Append)
from IH2[of "0"] obtain as'' where "prog2 ⊢ (_ 0 _) -as''→* (_Exit_)" by blast
hence "prog1;;prog2 ⊢ (_0_) ⊕ #:prog1 -as'' ⊕s #:prog1→* (_Exit_) ⊕ #:prog1"
by(fastforce intro!:path_SeqSecond elim:While_CFG.path.cases)
hence "prog1;;prog2 ⊢ (_0_) ⊕ #:prog1 -as'' ⊕s #:prog1→* (_Exit_)"
by simp
with ‹prog1;;prog2 ⊢ (_ l _) -asx@[(sourcenode ax,kind ax,(_0_) ⊕ #:prog1)]→*
(_0_) ⊕ #:prog1›
have "prog1;;prog2 ⊢ (_ l _) -(asx@[(sourcenode ax,kind ax,(_0_) ⊕ #:prog1)])@
(as'' ⊕s #:prog1)→* (_Exit_)"
by(fastforce intro:While_CFG.path_Append)
with ‹prog1;;prog2 ⊢ (_Entry_) -as'→* (_ l _)› show ?thesis by blast
next
case False
hence "#:prog1 ≤ l" by simp
then obtain l' where [simp]:"l = l' + #:prog1" and "l' = l - #:prog1" by simp
from ‹l < #:prog1;; prog2› have "l' < #:prog2" by simp
from IH2[OF this] obtain as as' where "prog2 ⊢ (_ l' _) -as→* (_Exit_)"
and "prog2 ⊢ (_Entry_) -as'→* (_ l' _)" by blast
from ‹prog2 ⊢ (_ l' _) -as→* (_Exit_)›
have "prog1;;prog2 ⊢ (_ l' _) ⊕ #:prog1 -as ⊕s #:prog1→* (_Exit_) ⊕ #:prog1"
by(fastforce intro!:path_SeqSecond elim:While_CFG.path.cases)
hence "prog1;;prog2 ⊢ (_ l _) -as ⊕s #:prog1→* (_Exit_)"
by simp
from IH1[of 0] obtain as'' where "prog1 ⊢ (_0_) -as''→* (_Exit_)" by blast
then obtain ax asx where "prog1 ⊢ (_0_) -asx@[ax]→* (_Exit_)"
by(induct rule:rev_induct,auto elim:While_CFG.path.cases)
hence "prog1 ⊢ (_0_) -asx→* sourcenode ax" and "valid_edge prog1 ax"
and "(_Exit_) = targetnode ax" by(auto intro:While_CFG.path_split_snoc)
from WCFG_Entry ‹prog1 ⊢ (_0_) -asx→* sourcenode ax›
have "prog1 ⊢ (_Entry_) -((_Entry_),(λs. True)⇩√,(_0_))#asx→* sourcenode ax"
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def valid_node_def)
from ‹prog1 ⊢ (_0_) -asx→* sourcenode ax› ‹valid_edge prog1 ax›
obtain lx where [simp]:"sourcenode ax = (_ lx _)"
by(cases "sourcenode ax") auto
with ‹prog1 ⊢ (_Entry_) -((_Entry_),(λs. True)⇩√,(_0_))#asx→* sourcenode ax›
have "prog1;;prog2 ⊢ (_Entry_) -((_Entry_),(λs. True)⇩√,(_0_))#asx→*
sourcenode ax"
by(fastforce intro:path_SeqFirst)
from ‹prog2 ⊢ (_Entry_) -as'→* (_ l' _)› obtain ax' asx'
where "prog2 ⊢ (_Entry_) -ax'#asx'→* (_ l' _)"
by(cases as',auto elim:While_CFG.path.cases)
hence "(_Entry_) = sourcenode ax'" and "valid_edge prog2 ax'"
and "prog2 ⊢ targetnode ax' -asx'→* (_ l' _)"
by(auto intro:While_CFG.path_split_Cons)
hence "targetnode ax' = (_0_)" by(fastforce dest:WCFG_EntryD simp:valid_edge_def)
from ‹valid_edge prog1 ax› ‹(_Exit_) = targetnode ax›
have "prog1;;prog2 ⊢ sourcenode ax -kind ax→ (_0_) ⊕ #:prog1"
by(fastforce intro:WCFG_SeqConnect simp:valid_edge_def)
have "∃as. prog1;;prog2 ⊢ sourcenode ax -as→* (_ l _)"
proof(cases "asx' = []")
case True
with ‹prog2 ⊢ targetnode ax' -asx'→* (_ l' _)› ‹targetnode ax' = (_0_)›
have "l' = 0" by(auto elim:While_CFG.path.cases)
with ‹prog1;;prog2 ⊢ sourcenode ax -kind ax→ (_0_) ⊕ #:prog1›
have "prog1;;prog2 ⊢ sourcenode ax -[(sourcenode ax,kind ax,(_ l _))]→*
(_ l _)"
by(auto intro!:While_CFG.path.intros
simp:While_CFG.valid_node_def valid_edge_def,blast)
thus ?thesis by blast
next
case False
with ‹prog2 ⊢ targetnode ax' -asx'→* (_ l' _)› ‹targetnode ax' = (_0_)›
have "prog1;;prog2 ⊢ (_0_) ⊕ #:prog1 -asx' ⊕s #:prog1→* (_ l' _) ⊕ #:prog1"
by(fastforce intro:path_SeqSecond)
hence "prog1;;prog2 ⊢ (_0_) ⊕ #:prog1 -asx' ⊕s #:prog1→* (_ l _)" by simp
with ‹prog1;;prog2 ⊢ sourcenode ax -kind ax→ (_0_) ⊕ #:prog1›
have "prog1;;prog2 ⊢ sourcenode ax -(sourcenode ax,kind ax,(_0_) ⊕ #:prog1)#
(asx' ⊕s #:prog1)→* (_ l _)"
by(fastforce intro: While_CFG.Cons_path simp:valid_node_def valid_edge_def)
thus ?thesis by blast
qed
then obtain asx'' where "prog1;;prog2 ⊢ sourcenode ax -asx''→* (_ l _)" by blast
with ‹prog1;;prog2 ⊢ (_Entry_) -((_Entry_),(λs. True)⇩√,(_0_))#asx→*
sourcenode ax›
have "prog1;;prog2 ⊢ (_Entry_) -(((_Entry_),(λs. True)⇩√,(_0_))#asx)@asx''→*
(_ l _)"
by(rule While_CFG.path_Append)
with ‹prog1;;prog2 ⊢ (_ l _) -as ⊕s #:prog1→* (_Exit_)›
show ?thesis by blast
qed
next
case (Cond b prog1 prog2)
note IH1 = ‹⋀l. l < #:prog1 ⟹
(∃as. prog1 ⊢ (_ l _) -as→* (_Exit_)) ∧ (∃as. prog1 ⊢ (_Entry_) -as→* (_ l _))›
note IH2 = ‹⋀l. l < #:prog2 ⟹
(∃as. prog2 ⊢ (_ l _) -as→* (_Exit_)) ∧ (∃as. prog2 ⊢ (_Entry_) -as→* (_ l _))›
show ?case
proof(cases "l = 0")
case True
from IH1[of 0] obtain as where "prog1 ⊢ (_0_) -as→* (_Exit_)" by blast
hence "if (b) prog1 else prog2 ⊢ (_0_) ⊕ 1 -as ⊕s 1→* (_Exit_) ⊕ 1"
by(fastforce intro:path_CondTrue)
with WCFG_CondTrue[of b prog1 prog2] have "if (b) prog1 else prog2 ⊢
(_0_) -((_0_),(λs. interpret b s = Some true)⇩√,(_0_) ⊕ 1)#(as ⊕s 1)→*
(_Exit_) ⊕ 1"
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def valid_node_def)
with True have "if (b) prog1 else prog2 ⊢
(_ l _) -((_0_),(λs. interpret b s = Some true)⇩√,(_0_) ⊕ 1)#(as ⊕s 1)→*
(_Exit_)" by simp
moreover
from WCFG_Entry[of "if (b) prog1 else prog2"] True
have "if (b) prog1 else prog2 ⊢ (_Entry_) -[((_Entry_),(λs. True)⇩√,(_0_))]→*
(_ l _)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:While_CFG.valid_node_def valid_edge_def)
ultimately show ?thesis by blast
next
case False
hence "0 < l" by simp
then obtain l' where [simp]:"l = l' + 1" and "l' = l - 1" by simp
show ?thesis
proof(cases "l' < #:prog1")
case True
from IH1[OF this] obtain as as' where "prog1 ⊢ (_ l' _) -as→* (_Exit_)"
and "prog1 ⊢ (_Entry_) -as'→* (_ l' _)" by blast
from ‹prog1 ⊢ (_ l' _) -as→* (_Exit_)›
have "if (b) prog1 else prog2 ⊢ (_ l' _) ⊕ 1 -as ⊕s 1→* (_Exit_) ⊕ 1"
by(fastforce intro:path_CondTrue)
hence "if (b) prog1 else prog2 ⊢ (_ l _) -as ⊕s 1→* (_Exit_)"
by simp
from ‹prog1 ⊢ (_Entry_) -as'→* (_ l' _)› obtain ax asx
where "prog1 ⊢ (_Entry_) -ax#asx→* (_ l' _)"
by(cases as',auto elim:While_CFG.cases)
hence "(_Entry_) = sourcenode ax" and "valid_edge prog1 ax"
and "prog1 ⊢ targetnode ax -asx→* (_ l' _)"
by(auto intro:While_CFG.path_split_Cons)
hence "targetnode ax = (_0_)" by(fastforce dest:WCFG_EntryD simp:valid_edge_def)
with ‹prog1 ⊢ targetnode ax -asx→* (_ l' _)›
have "if (b) prog1 else prog2 ⊢ (_0_) ⊕ 1 -asx ⊕s 1→* (_ l' _) ⊕ 1"
by(fastforce intro:path_CondTrue)
with WCFG_CondTrue[of b prog1 prog2]
have "if (b) prog1 else prog2 ⊢ (_0_)
-((_0_),(λs. interpret b s = Some true)⇩√,(_0_) ⊕ 1)#(asx ⊕s 1)→*
(_ l' _) ⊕ 1"
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
with WCFG_Entry[of "if (b) prog1 else prog2"]
have "if (b) prog1 else prog2 ⊢ (_Entry_) -((_Entry_),(λs. True)⇩√,(_0_))#
((_0_),(λs. interpret b s = Some true)⇩√,(_0_) ⊕ 1)#(asx ⊕s 1)→*
(_ l' _) ⊕ 1"
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
with ‹if (b) prog1 else prog2 ⊢ (_ l _) -as ⊕s 1→* (_Exit_)›
show ?thesis by simp blast
next
case False
hence "#:prog1 ≤ l'" by simp
then obtain l'' where [simp]:"l' = l'' + #:prog1" and "l'' = l' - #:prog1"
by simp
from ‹l < #:(if (b) prog1 else prog2)›
have "l'' < #:prog2" by simp
from IH2[OF this] obtain as as' where "prog2 ⊢ (_ l'' _) -as→* (_Exit_)"
and "prog2 ⊢ (_Entry_) -as'→* (_ l'' _)" by blast
from ‹prog2 ⊢ (_ l'' _) -as→* (_Exit_)›
have "if (b) prog1 else prog2 ⊢ (_ l'' _) ⊕ (#:prog1 + 1)
-as ⊕s (#:prog1 + 1)→* (_Exit_) ⊕ (#:prog1 + 1)"
by(fastforce intro:path_CondFalse)
hence "if (b) prog1 else prog2 ⊢ (_ l _) -as ⊕s (#:prog1 + 1)→* (_Exit_)"
by(simp add:add.assoc)
from ‹prog2 ⊢ (_Entry_) -as'→* (_ l'' _)› obtain ax asx
where "prog2 ⊢ (_Entry_) -ax#asx→* (_ l'' _)"
by(cases as',auto elim:While_CFG.cases)
hence "(_Entry_) = sourcenode ax" and "valid_edge prog2 ax"
and "prog2 ⊢ targetnode ax -asx→* (_ l'' _)"
by(auto intro:While_CFG.path_split_Cons)
hence "targetnode ax = (_0_)" by(fastforce dest:WCFG_EntryD simp:valid_edge_def)
with ‹prog2 ⊢ targetnode ax -asx→* (_ l'' _)›
have "if (b) prog1 else prog2 ⊢ (_0_) ⊕ (#:prog1 + 1) -asx ⊕s (#:prog1 + 1)→*
(_ l'' _) ⊕ (#:prog1 + 1)"
by(fastforce intro:path_CondFalse)
with WCFG_CondFalse[of b prog1 prog2]
have "if (b) prog1 else prog2 ⊢ (_0_)
-((_0_),(λs. interpret b s = Some false)⇩√,(_0_) ⊕ (#:prog1 + 1))#
(asx ⊕s (#:prog1 + 1))→* (_ l'' _) ⊕ (#:prog1 + 1)"
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
with WCFG_Entry[of "if (b) prog1 else prog2"]
have "if (b) prog1 else prog2 ⊢ (_Entry_) -((_Entry_),(λs. True)⇩√,(_0_))#
((_0_),(λs. interpret b s = Some false)⇩√,(_0_) ⊕ (#:prog1 + 1))#
(asx ⊕s (#:prog1 + 1))→* (_ l'' _) ⊕ (#:prog1 + 1)"
by(fastforce intro:While_CFG.Cons_path simp:valid_edge_def)
with
‹if (b) prog1 else prog2 ⊢ (_ l _) -as ⊕s (#:prog1 + 1)→* (_Exit_)›
show ?thesis by(simp add:add.assoc,blast)
qed
qed
next
case (While b prog')
note IH = ‹⋀l. l < #:prog' ⟹
(∃as. prog' ⊢ (_ l _) -as→* (_Exit_)) ∧ (∃as. prog' ⊢ (_Entry_) -as→* (_ l _))›
show ?case
proof(cases "l < 1")
case True
from WCFG_Entry[of "while (b) prog'"]
have "while (b) prog' ⊢ (_Entry_) -[((_Entry_),(λs. True)⇩√,(_0_))]→* (_0_)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:While_CFG.valid_node_def valid_edge_def)
from WCFG_WhileFalseSkip[of b prog']
have "while (b) prog' ⊢ (_1_) -[((_1_),⇑id,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:valid_node_def valid_edge_def)
with WCFG_WhileFalse[of b prog']
have "while (b) prog' ⊢ (_0_) -((_0_),(λs. interpret b s = Some false)⇩√,(_1_))#
[((_1_),⇑id,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:valid_node_def valid_edge_def)
with ‹while (b) prog' ⊢ (_Entry_) -[((_Entry_),(λs. True)⇩√,(_0_))]→* (_0_)› True
show ?thesis by simp blast
next
case False
hence "1 ≤ l" by simp
thus ?thesis
proof(cases "l < 2")
case True
with ‹1 ≤ l› have [simp]:"l = 1" by simp
from WCFG_WhileFalseSkip[of b prog']
have "while (b) prog' ⊢ (_1_) -[((_1_),⇑id,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:valid_node_def valid_edge_def)
from WCFG_WhileFalse[of b prog']
have "while (b) prog' ⊢ (_0_)
-[((_0_),(λs. interpret b s = Some false)⇩√,(_1_))]→* (_1_)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:While_CFG.valid_node_def valid_edge_def)
with WCFG_Entry[of "while (b) prog'"]
have "while (b) prog' ⊢ (_Entry_) -((_Entry_),(λs. True)⇩√,(_0_))#
[((_0_),(λs. interpret b s = Some false)⇩√,(_1_))]→* (_1_)"
by(fastforce intro:While_CFG.Cons_path simp:valid_node_def valid_edge_def)
with ‹while (b) prog' ⊢ (_1_) -[((_1_),⇑id,(_Exit_))]→* (_Exit_)›
show ?thesis by simp blast
next
case False
with ‹1 ≤ l› have "2 ≤ l" by simp
then obtain l' where [simp]:"l = l' + 2" and "l' = l - 2"
by(simp del:add_2_eq_Suc')
from ‹l < #:while (b) prog'› have "l' < #:prog'" by simp
from IH[OF this] obtain as as' where "prog' ⊢ (_ l' _) -as→* (_Exit_)"
and "prog' ⊢ (_Entry_) -as'→* (_ l' _)" by blast
from ‹prog' ⊢ (_ l' _) -as→* (_Exit_)› obtain ax asx where
"prog' ⊢ (_ l' _) -asx@[ax]→* (_Exit_)"
by(induct as rule:rev_induct,auto elim:While_CFG.cases)
hence "prog' ⊢ (_ l' _) -asx→* sourcenode ax" and "valid_edge prog' ax"
and "(_Exit_) = targetnode ax"
by(auto intro:While_CFG.path_split_snoc)
then obtain lx where "sourcenode ax = (_ lx _)"
by(cases "sourcenode ax") auto
with ‹prog' ⊢ (_ l' _) -asx→* sourcenode ax›
have "while (b) prog' ⊢ (_ l' _) ⊕ 2 -asx ⊕s 2→* sourcenode ax ⊕ 2"
by(fastforce intro:path_While simp del:label_incr.simps)
from WCFG_WhileFalseSkip[of b prog']
have "while (b) prog' ⊢ (_1_) -[((_1_),⇑id,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:valid_node_def valid_edge_def)
with WCFG_WhileFalse[of b prog']
have "while (b) prog' ⊢ (_0_) -((_0_),(λs. interpret b s = Some false)⇩√,(_1_))#
[((_1_),⇑id,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.Cons_path simp:valid_node_def valid_edge_def)
with ‹valid_edge prog' ax› ‹(_Exit_) = targetnode ax› ‹sourcenode ax = (_ lx _)›
have "while (b) prog' ⊢ sourcenode ax ⊕ 2 -(sourcenode ax ⊕ 2,kind ax,(_0_))#
((_0_),(λs. interpret b s = Some false)⇩√,(_1_))#
[((_1_),⇑id,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.Cons_path dest:WCFG_WhileBodyExit
simp:valid_node_def valid_edge_def)
with ‹while (b) prog' ⊢ (_ l' _) ⊕ 2 -asx ⊕s 2→* sourcenode ax ⊕ 2›
have path:"while (b) prog' ⊢ (_ l' _) ⊕ 2 -(asx ⊕s 2)@
((sourcenode ax ⊕ 2,kind ax,(_0_))#
((_0_),(λs. interpret b s = Some false)⇩√,(_1_))#
[((_1_),⇑id,(_Exit_))])→* (_Exit_)"
by(rule While_CFG.path_Append)
from ‹prog' ⊢ (_Entry_) -as'→* (_ l' _)› obtain ax' asx'
where "prog' ⊢ (_Entry_) -ax'#asx'→* (_ l' _)"
by(cases as',auto elim:While_CFG.cases)
hence "(_Entry_) = sourcenode ax'" and "valid_edge prog' ax'"
and "prog' ⊢ targetnode ax' -asx'→* (_ l' _)"
by(auto intro:While_CFG.path_split_Cons)
hence "targetnode ax' = (_0_)" by(fastforce dest:WCFG_EntryD simp:valid_edge_def)
with ‹prog' ⊢ targetnode ax' -asx'→* (_ l' _)›
have "while (b) prog' ⊢ (_0_) ⊕ 2 -asx' ⊕s 2→* (_ l' _) ⊕ 2"
by(fastforce intro:path_While)
with WCFG_WhileTrue[of b prog']
have "while (b) prog' ⊢ (_0_)
-((_0_),(λs. interpret b s = Some true)⇩√,(_0_) ⊕ 2)#(asx' ⊕s 2)→*
(_ l' _) ⊕ 2"
by(fastforce intro:While_CFG.Cons_path simp:valid_node_def valid_edge_def)
with WCFG_Entry[of "while (b) prog'"]
have "while (b) prog' ⊢ (_Entry_) -((_Entry_),(λs. True)⇩√,(_0_))#
((_0_),(λs. interpret b s = Some true)⇩√,(_0_) ⊕ 2)#(asx' ⊕s 2)→*
(_ l' _) ⊕ 2"
by(fastforce intro:While_CFG.Cons_path simp:valid_node_def valid_edge_def)
with path show ?thesis by simp blast
qed
qed
qed
declare add_2_eq_Suc' [simp] One_nat_def [simp]
lemma valid_node_Exit_path:
assumes "valid_node prog n" shows "∃as. prog ⊢ n -as→* (_Exit_)"
proof(cases n)
case (Node l)
with ‹valid_node prog n› have "l < #:prog"
by(fastforce dest:WCFG_sourcelabel_less_num_nodes WCFG_targetlabel_less_num_nodes
simp:valid_node_def valid_edge_def)
with Node show ?thesis by(fastforce dest:inner_node_Entry_Exit_path)
next
case Entry
from WCFG_Entry_Exit[of prog]
have "prog ⊢ (_Entry_) -[((_Entry_),(λs. False)⇩√,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:valid_node_def valid_edge_def)
with Entry show ?thesis by blast
next
case Exit
with WCFG_Entry_Exit[of prog]
have "prog ⊢ n -[]→* (_Exit_)"
by(fastforce intro:While_CFG.empty_path simp:valid_node_def valid_edge_def)
thus ?thesis by blast
qed
lemma valid_node_Entry_path:
assumes "valid_node prog n" shows "∃as. prog ⊢ (_Entry_) -as→* n"
proof(cases n)
case (Node l)
with ‹valid_node prog n› have "l < #:prog"
by(fastforce dest:WCFG_sourcelabel_less_num_nodes WCFG_targetlabel_less_num_nodes
simp:valid_node_def valid_edge_def)
with Node show ?thesis by(fastforce dest:inner_node_Entry_Exit_path)
next
case Entry
with WCFG_Entry_Exit[of prog]
have "prog ⊢ (_Entry_) -[]→* n"
by(fastforce intro:While_CFG.empty_path simp:valid_node_def valid_edge_def)
thus ?thesis by blast
next
case Exit
from WCFG_Entry_Exit[of prog]
have "prog ⊢ (_Entry_) -[((_Entry_),(λs. False)⇩√,(_Exit_))]→* (_Exit_)"
by(fastforce intro:While_CFG.Cons_path While_CFG.empty_path
simp:valid_node_def valid_edge_def)
with Exit show ?thesis by blast
qed
subsection ‹Some finiteness considerations›
lemma finite_labels:"finite {l. ∃c. labels prog l c}"
proof -
have "finite {l::nat. l < #:prog}" by(fastforce intro:nat_seg_image_imp_finite)
moreover have "{l. ∃c. labels prog l c} ⊆ {l::nat. l < #:prog}"
by(fastforce intro:label_less_num_inner_nodes)
ultimately show ?thesis by(auto intro:finite_subset)
qed
lemma finite_valid_nodes:"finite {n. valid_node prog n}"
proof -
have "{n. ∃n' et. prog ⊢ n -et→ n'} ⊆
insert (_Entry_) ((λl'. (_ l' _)) ` {l. ∃c. labels prog l c})"
apply clarsimp
apply(case_tac x,auto)
by(fastforce dest:WCFG_sourcelabel_less_num_nodes less_num_inner_nodes_label)
hence "finite {n. ∃n' et. prog ⊢ n -et→ n'}"
by(auto intro:finite_subset finite_imageI finite_labels)
have "{n'. ∃n et. prog ⊢ n -et→ n'} ⊆
insert (_Exit_) ((λl'. (_ l' _)) ` {l. ∃c. labels prog l c})"
apply clarsimp
apply(case_tac x,auto)
by(fastforce dest:WCFG_targetlabel_less_num_nodes less_num_inner_nodes_label)
hence "finite {n'. ∃n et. prog ⊢ n -et→ n'}"
by(auto intro:finite_subset finite_imageI finite_labels)
have "{n. ∃nx et nx'. prog ⊢ nx -et→ nx' ∧ (n = nx ∨ n = nx')} =
{n. ∃n' et. prog ⊢ n -et→ n'} Un {n'. ∃n et. prog ⊢ n -et→ n'}" by blast
with ‹finite {n. ∃n' et. prog ⊢ n -et→ n'}› ‹finite {n'. ∃n et. prog ⊢ n -et→ n'}›
have "finite {n. ∃nx et nx'. prog ⊢ nx -et→ nx' ∧ (n = nx ∨ n = nx')}"
by fastforce
thus ?thesis by(simp add:valid_node_def valid_edge_def)
qed
lemma finite_successors:
"finite {n'. ∃a'. valid_edge prog a' ∧ sourcenode a' = n ∧
targetnode a' = n'}"
proof -
have "{n'. ∃a'. valid_edge prog a' ∧ sourcenode a' = n ∧
targetnode a' = n'} ⊆ {n. valid_node prog n}"
by(auto simp:valid_edge_def valid_node_def)
thus ?thesis by(fastforce elim:finite_subset intro:finite_valid_nodes)
qed
end
Theory DynamicControlDependences
section ‹Interpretations of the various dynamic control dependences›
theory DynamicControlDependences imports AdditionalLemmas "../Dynamic/DynPDG" begin
interpretation WDynStandardControlDependence:
DynStandardControlDependencePDG sourcenode targetnode kind "valid_edge prog"
Entry "Defs prog" "Uses prog" id Exit
for prog
proof(unfold_locales)
fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
thus "∃as. prog ⊢ (_Entry_) -as→* n" by(rule valid_node_Entry_path)
next
fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
thus "∃as. prog ⊢ n -as→* (_Exit_)" by(rule valid_node_Exit_path)
qed
interpretation WDynWeakControlDependence:
DynWeakControlDependencePDG sourcenode targetnode kind "valid_edge prog"
Entry "Defs prog" "Uses prog" id Exit
for prog
proof(unfold_locales)
fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
show "finite {n'. ∃a'. valid_edge prog a' ∧ sourcenode a' = n ∧
targetnode a' = n'}"
by(rule finite_successors)
qed
end
Theory Semantics
section ‹Semantics›
theory Semantics imports Labels Com begin
subsection ‹Small Step Semantics›
inductive red :: "cmd * state ⇒ cmd * state ⇒ bool"
and red' :: "cmd ⇒ state ⇒ cmd ⇒ state ⇒ bool"
("((1⟨_,/_⟩) →/ (1⟨_,/_⟩))" [0,0,0,0] 81)
where
"⟨c,s⟩ → ⟨c',s'⟩ == red (c,s) (c',s')"
| RedLAss:
"⟨V:=e,s⟩ → ⟨Skip,s(V:=(interpret e s))⟩"
| SeqRed:
"⟨c⇩1,s⟩ → ⟨c⇩1',s'⟩ ⟹ ⟨c⇩1;;c⇩2,s⟩ → ⟨c⇩1';;c⇩2,s'⟩"
| RedSeq:
"⟨Skip;;c⇩2,s⟩ → ⟨c⇩2,s⟩"
| RedCondTrue:
"interpret b s = Some true ⟹ ⟨if (b) c⇩1 else c⇩2,s⟩ → ⟨c⇩1,s⟩"
| RedCondFalse:
"interpret b s = Some false ⟹ ⟨if (b) c⇩1 else c⇩2,s⟩ → ⟨c⇩2,s⟩"
| RedWhileTrue:
"interpret b s = Some true ⟹ ⟨while (b) c,s⟩ → ⟨c;;while (b) c,s⟩"
| RedWhileFalse:
"interpret b s = Some false ⟹ ⟨while (b) c,s⟩ → ⟨Skip,s⟩"
lemmas red_induct = red.induct[split_format (complete)]
abbreviation reds ::"cmd ⇒ state ⇒ cmd ⇒ state ⇒ bool"
("((1⟨_,/_⟩) →*/ (1⟨_,/_⟩))" [0,0,0,0] 81) where
"⟨c,s⟩ →* ⟨c',s'⟩ == red⇧*⇧* (c,s) (c',s')"
subsection‹Label Semantics›
inductive step :: "cmd ⇒ cmd ⇒ state ⇒ nat ⇒ cmd ⇒ state ⇒ nat ⇒ bool"
("(_ ⊢ (1⟨_,/_,/_⟩) ↝/ (1⟨_,/_,/_⟩))" [51,0,0,0,0,0,0] 81)
where
StepLAss:
"V:=e ⊢ ⟨V:=e,s,0⟩ ↝ ⟨Skip,s(V:=(interpret e s)),1⟩"
| StepSeq:
"⟦labels (c⇩1;;c⇩2) l (Skip;;c⇩2); labels (c⇩1;;c⇩2) #:c⇩1 c⇩2; l < #:c⇩1⟧
⟹ c⇩1;;c⇩2 ⊢ ⟨Skip;;c⇩2,s,l⟩ ↝ ⟨c⇩2,s,#:c⇩1⟩"
| StepSeqWhile:
"labels (while (b) c') l (Skip;;while (b) c')
⟹ while (b) c' ⊢ ⟨Skip;;while (b) c',s,l⟩ ↝ ⟨while (b) c',s,0⟩"
| StepCondTrue:
"interpret b s = Some true
⟹ if (b) c⇩1 else c⇩2 ⊢ ⟨if (b) c⇩1 else c⇩2,s,0⟩ ↝ ⟨c⇩1,s,1⟩"
| StepCondFalse:
"interpret b s = Some false
⟹ if (b) c⇩1 else c⇩2 ⊢ ⟨if (b) c⇩1 else c⇩2,s,0⟩ ↝ ⟨c⇩2,s,#:c⇩1 + 1⟩"
| StepWhileTrue:
"interpret b s = Some true
⟹ while (b) c ⊢ ⟨while (b) c,s,0⟩ ↝ ⟨c;;while (b) c,s,2⟩"
| StepWhileFalse:
"interpret b s = Some false ⟹ while (b) c ⊢ ⟨while (b) c,s,0⟩ ↝ ⟨Skip,s,1⟩"
| StepRecSeq1:
"prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩
⟹ prog;;c⇩2 ⊢ ⟨c;;c⇩2,s,l⟩ ↝ ⟨c';;c⇩2,s',l'⟩"
| StepRecSeq2:
"prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩
⟹ c⇩1;;prog ⊢ ⟨c,s,l + #:c⇩1⟩ ↝ ⟨c',s',l' + #:c⇩1⟩"
| StepRecCond1:
"prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩
⟹ if (b) prog else c⇩2 ⊢ ⟨c,s,l + 1⟩ ↝ ⟨c',s',l' + 1⟩"
| StepRecCond2:
"prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩
⟹ if (b) c⇩1 else prog ⊢ ⟨c,s,l + #:c⇩1 + 1⟩ ↝ ⟨c',s',l' + #:c⇩1 + 1⟩"
| StepRecWhile:
"cx ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩
⟹ while (b) cx ⊢ ⟨c;;while (b) cx,s,l + 2⟩ ↝ ⟨c';;while (b) cx,s',l' + 2⟩"
lemma step_label_less:
"prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ⟹ l < #:prog ∧ l' < #:prog"
proof(induct rule:step.induct)
case (StepSeq c⇩1 c⇩2 l s)
from ‹labels (c⇩1;;c⇩2) l (Skip;;c⇩2)›
have "l < #:(c⇩1;; c⇩2)" by(rule label_less_num_inner_nodes)
thus ?case by(simp add:num_inner_nodes_gr_0)
next
case (StepSeqWhile b cx l s)
from ‹labels (while (b) cx) l (Skip;;while (b) cx)›
have "l < #:(while (b) cx)" by(rule label_less_num_inner_nodes)
thus ?case by simp
qed (auto intro:num_inner_nodes_gr_0)
abbreviation steps :: "cmd ⇒ cmd ⇒ state ⇒ nat ⇒ cmd ⇒ state ⇒ nat ⇒ bool"
("(_ ⊢ (1⟨_,/_,/_⟩) ↝*/ (1⟨_,/_,/_⟩))" [51,0,0,0,0,0,0] 81) where
"prog ⊢ ⟨c,s,l⟩ ↝* ⟨c',s',l'⟩ ==
(λ(c,s,l) (c',s',l'). prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩)⇧*⇧* (c,s,l) (c',s',l')"
subsection‹Proof of bisimulation of @{term "⟨c,s⟩ → ⟨c',s'⟩"}\\
and @{term "prog ⊢ ⟨c,s,l⟩ ↝* ⟨c',s',l'⟩"} via @{term "labels"}›
lemmas converse_rtranclp_induct3 =
converse_rtranclp_induct[of _ "(ax,ay,az)" "(bx,by,bz)", split_rule,
consumes 1, case_names refl step]
subsubsection ‹From @{term "prog ⊢ ⟨c,s,l⟩ ↝* ⟨c',s',l'⟩"} to
@{term "⟨c,s⟩ → ⟨c',s'⟩"}›
lemma step_red:
"prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ⟹ ⟨c,s⟩ → ⟨c',s'⟩"
by(induct rule:step.induct,rule RedLAss,auto intro:red.intros)
lemma steps_reds:
"prog ⊢ ⟨c,s,l⟩ ↝* ⟨c',s',l'⟩ ⟹ ⟨c,s⟩ →* ⟨c',s'⟩"
proof(induct rule:converse_rtranclp_induct3)
case refl thus ?case by simp
next
case (step c s l c'' s'' l'')
then have "prog ⊢ ⟨c,s,l⟩ ↝ ⟨c'',s'',l''⟩"
and "⟨c'',s''⟩ →* ⟨c',s'⟩" by simp_all
from ‹prog ⊢ ⟨c,s,l⟩ ↝ ⟨c'',s'',l''⟩› have "⟨c,s⟩ → ⟨c'',s''⟩"
by(fastforce intro:step_red)
with ‹⟨c'',s''⟩ →* ⟨c',s'⟩› show ?case
by(fastforce intro:converse_rtranclp_into_rtranclp)
qed
declare fun_upd_apply [simp del] One_nat_def [simp del]
subsubsection ‹From @{term "⟨c,s⟩ → ⟨c',s'⟩"} and @{term labels} to
@{term "prog ⊢ ⟨c,s,l⟩ ↝* ⟨c',s',l'⟩"}›
lemma red_step:
"⟦labels prog l c; ⟨c,s⟩ → ⟨c',s'⟩⟧
⟹ ∃l'. prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels prog l' c'"
proof(induct arbitrary:c' rule:labels.induct)
case (Labels_Base c)
from ‹⟨c,s⟩ → ⟨c',s'⟩› show ?case
proof(induct rule:red_induct)
case (RedLAss V e s)
have "V:=e ⊢ ⟨V:=e,s,0⟩ ↝ ⟨Skip,s(V:=(interpret e s)),1⟩" by(rule StepLAss)
have "labels (V:=e) 1 Skip" by(fastforce intro:Labels_LAss)
with ‹V:=e ⊢ ⟨V:=e,s,0⟩ ↝ ⟨Skip,s(V:=(interpret e s)),1⟩› show ?case by blast
next
case (SeqRed c⇩1 s c⇩1' s' c⇩2)
from ‹∃l'. c⇩1 ⊢ ⟨c⇩1,s,0⟩ ↝ ⟨c⇩1',s',l'⟩ ∧ labels c⇩1 l' c⇩1'›
obtain l' where "c⇩1 ⊢ ⟨c⇩1,s,0⟩ ↝ ⟨c⇩1',s',l'⟩" and "labels c⇩1 l' c⇩1'" by blast
from ‹c⇩1 ⊢ ⟨c⇩1,s,0⟩ ↝ ⟨c⇩1',s',l'⟩› have "c⇩1;;c⇩2 ⊢ ⟨c⇩1;;c⇩2,s,0⟩ ↝ ⟨c⇩1';;c⇩2,s',l'⟩"
by(rule StepRecSeq1)
moreover
from ‹labels c⇩1 l' c⇩1'› have "labels (c⇩1;;c⇩2) l' (c⇩1';;c⇩2)" by(rule Labels_Seq1)
ultimately show ?case by blast
next
case (RedSeq c⇩2 s)
have "labels c⇩2 0 c⇩2" by(rule Labels.Labels_Base)
hence "labels (Skip;;c⇩2) (0 + #:Skip) c⇩2" by(rule Labels_Seq2)
have "labels (Skip;;c⇩2) 0 (Skip;;c⇩2)" by(rule Labels.Labels_Base)
with ‹labels (Skip;;c⇩2) (0 + #:Skip) c⇩2›
have "Skip;;c⇩2 ⊢ ⟨Skip;;c⇩2,s,0⟩ ↝ ⟨c⇩2,s,#:Skip⟩"
by(fastforce intro:StepSeq)
with ‹labels (Skip;;c⇩2) (0 + #:Skip) c⇩2› show ?case by auto
next
case (RedCondTrue b s c⇩1 c⇩2)
from ‹interpret b s = Some true›
have "if (b) c⇩1 else c⇩2 ⊢ ⟨if (b) c⇩1 else c⇩2,s,0⟩ ↝ ⟨c⇩1,s,1⟩"
by(rule StepCondTrue)
have "labels (if (b) c⇩1 else c⇩2) (0 + 1) c⇩1"
by(rule Labels_CondTrue,rule Labels.Labels_Base)
with ‹if (b) c⇩1 else c⇩2 ⊢ ⟨if (b) c⇩1 else c⇩2,s,0⟩ ↝ ⟨c⇩1,s,1⟩› show ?case by auto
next
case (RedCondFalse b s c⇩1 c⇩2)
from ‹interpret b s = Some false›
have "if (b) c⇩1 else c⇩2 ⊢ ⟨if (b) c⇩1 else c⇩2,s,0⟩ ↝ ⟨c⇩2,s,#:c⇩1 + 1⟩"
by(rule StepCondFalse)
have "labels (if (b) c⇩1 else c⇩2) (0 + #:c⇩1 + 1) c⇩2"
by(rule Labels_CondFalse,rule Labels.Labels_Base)
with ‹if (b) c⇩1 else c⇩2 ⊢ ⟨if (b) c⇩1 else c⇩2,s,0⟩ ↝ ⟨c⇩2,s,#:c⇩1 + 1⟩›
show ?case by auto
next
case (RedWhileTrue b s c)
from ‹interpret b s = Some true›
have "while (b) c ⊢ ⟨while (b) c,s,0⟩ ↝ ⟨c;; while (b) c,s,2⟩"
by(rule StepWhileTrue)
have "labels (while (b) c) (0 + 2) (c;; while (b) c)"
by(rule Labels_WhileBody,rule Labels.Labels_Base)
with ‹while (b) c ⊢ ⟨while (b) c,s,0⟩ ↝ ⟨c;; while (b) c,s,2⟩›
show ?case by(auto simp del:add_2_eq_Suc')
next
case (RedWhileFalse b s c)
from ‹interpret b s = Some false›
have "while (b) c ⊢ ⟨while (b) c,s,0⟩ ↝ ⟨Skip,s,1⟩"
by(rule StepWhileFalse)
have "labels (while (b) c) 1 Skip" by(rule Labels_WhileExit)
with ‹while (b) c ⊢ ⟨while (b) c,s,0⟩ ↝ ⟨Skip,s,1⟩› show ?case by auto
qed
next
case (Labels_LAss V e)
from ‹⟨Skip,s⟩ → ⟨c',s'⟩› have False by(auto elim:red.cases)
thus ?case by simp
next
case (Labels_Seq1 c⇩1 l c c⇩2)
note IH = ‹⋀c'. ⟨c,s⟩ → ⟨c',s'⟩ ⟹
∃l'. c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels c⇩1 l' c'›
from ‹⟨c;;c⇩2,s⟩ → ⟨c',s'⟩›
have "(c = Skip ∧ c' = c⇩2 ∧ s = s') ∨ (∃c''. c' = c'';;c⇩2)"
by -(erule red.cases,auto)
thus ?case
proof
assume [simp]:"c = Skip ∧ c' = c⇩2 ∧ s = s'"
from ‹labels c⇩1 l c› have "l < #:c⇩1"
by(rule label_less_num_inner_nodes[simplified])
have "labels (c⇩1;;c⇩2) (0 + #:c⇩1) c⇩2"
by(rule Labels_Seq2,rule Labels_Base)
from ‹labels c⇩1 l c› have "labels (c⇩1;; c⇩2) l (Skip;;c⇩2)"
by(fastforce intro:Labels.Labels_Seq1)
with ‹labels (c⇩1;;c⇩2) (0 + #:c⇩1) c⇩2› ‹l < #:c⇩1›
have "c⇩1;; c⇩2 ⊢ ⟨Skip;;c⇩2,s,l⟩ ↝ ⟨c⇩2,s,#:c⇩1⟩"
by(fastforce intro:StepSeq)
with ‹labels (c⇩1;;c⇩2) (0 + #:c⇩1) c⇩2› show ?case by auto
next
assume "∃c''. c' = c'';;c⇩2"
then obtain c'' where [simp]:"c' = c'';;c⇩2" by blast
have "c⇩2 ≠ c'';; c⇩2"
by (induction c⇩2) auto
with ‹⟨c;;c⇩2,s⟩ → ⟨c',s'⟩› have "⟨c,s⟩ → ⟨c'',s'⟩"
by (auto elim!:red.cases)
from IH[OF this] obtain l' where "c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c'',s',l'⟩"
and "labels c⇩1 l' c''" by blast
from ‹c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c'',s',l'⟩› have "c⇩1;;c⇩2 ⊢ ⟨c;;c⇩2,s,l⟩ ↝ ⟨c'';;c⇩2,s',l'⟩"
by(rule StepRecSeq1)
from ‹labels c⇩1 l' c''› have "labels (c⇩1;;c⇩2) l' (c'';;c⇩2)"
by(rule Labels.Labels_Seq1)
with ‹c⇩1;;c⇩2 ⊢ ⟨c;;c⇩2,s,l⟩ ↝ ⟨c'';;c⇩2,s',l'⟩› show ?case by auto
qed
next
case (Labels_Seq2 c⇩2 l c c⇩1 c')
note IH = ‹⋀c'. ⟨c,s⟩ → ⟨c',s'⟩ ⟹
∃l'. c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels c⇩2 l' c'›
from IH[OF ‹⟨c,s⟩ → ⟨c',s'⟩›] obtain l' where "c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"
and "labels c⇩2 l' c'" by blast
from ‹c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩› have "c⇩1;; c⇩2 ⊢ ⟨c,s,l + #:c⇩1⟩ ↝ ⟨c',s',l' + #:c⇩1⟩"
by(rule StepRecSeq2)
moreover
from ‹labels c⇩2 l' c'› have "labels (c⇩1;;c⇩2) (l' + #:c⇩1) c'"
by(rule Labels.Labels_Seq2)
ultimately show ?case by blast
next
case (Labels_CondTrue c⇩1 l c b c⇩2 c')
note label = ‹labels c⇩1 l c› and red = ‹⟨c,s⟩ → ⟨c',s'⟩›
and IH = ‹⋀c'. ⟨c,s⟩ → ⟨c',s'⟩ ⟹
∃l'. c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels c⇩1 l' c'›
from IH[OF ‹⟨c,s⟩ → ⟨c',s'⟩›] obtain l' where "c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"
and "labels c⇩1 l' c'" by blast
from ‹c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩›
have "if (b) c⇩1 else c⇩2 ⊢ ⟨c,s,l + 1⟩ ↝ ⟨c',s',l' + 1⟩"
by(rule StepRecCond1)
moreover
from ‹labels c⇩1 l' c'› have "labels (if (b) c⇩1 else c⇩2) (l' + 1) c'"
by(rule Labels.Labels_CondTrue)
ultimately show ?case by blast
next
case (Labels_CondFalse c⇩2 l c b c⇩1 c')
note IH = ‹⋀c'. ⟨c,s⟩ → ⟨c',s'⟩ ⟹
∃l'. c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels c⇩2 l' c'›
from IH[OF ‹⟨c,s⟩ → ⟨c',s'⟩›] obtain l' where "c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"
and "labels c⇩2 l' c'" by blast
from ‹c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩›
have "if (b) c⇩1 else c⇩2 ⊢ ⟨c,s,l + #:c⇩1 + 1⟩ ↝ ⟨c',s',l' + #:c⇩1 + 1⟩"
by(rule StepRecCond2)
moreover
from ‹labels c⇩2 l' c'› have "labels (if (b) c⇩1 else c⇩2) (l' + #:c⇩1 + 1) c'"
by(rule Labels.Labels_CondFalse)
ultimately show ?case by blast
next
case (Labels_WhileBody c' l c b cx)
note IH = ‹⋀c''. ⟨c,s⟩ → ⟨c'',s'⟩ ⟹
∃l'. c' ⊢ ⟨c,s,l⟩ ↝ ⟨c'',s',l'⟩ ∧ labels c' l' c''›
from ‹⟨c;;while (b) c',s⟩ → ⟨cx,s'⟩›
have "(c = Skip ∧ cx = while (b) c' ∧ s = s') ∨ (∃c''. cx = c'';;while (b) c')"
by -(erule red.cases,auto)
thus ?case
proof
assume [simp]:"c = Skip ∧ cx = while (b) c' ∧ s = s'"
have "labels (while (b) c') 0 (while (b) c')"
by(fastforce intro:Labels_Base)
from ‹labels c' l c› have "labels (while (b) c') (l + 2) (Skip;;while (b) c')"
by(fastforce intro:Labels.Labels_WhileBody simp del:add_2_eq_Suc')
hence "while (b) c' ⊢ ⟨Skip;;while (b) c',s,l + 2⟩ ↝ ⟨while (b) c',s,0⟩"
by(rule StepSeqWhile)
with ‹labels (while (b) c') 0 (while (b) c')› show ?case by simp blast
next
assume "∃c''. cx = c'';;while (b) c'"
then obtain c'' where [simp]:"cx = c'';;while (b) c'" by blast
with ‹⟨c;;while (b) c',s⟩ → ⟨cx,s'⟩› have "⟨c,s⟩ → ⟨c'',s'⟩"
by(auto elim:red.cases)
from IH[OF this] obtain l' where "c' ⊢ ⟨c,s,l⟩ ↝ ⟨c'',s',l'⟩"
and "labels c' l' c''" by blast
from ‹c' ⊢ ⟨c,s,l⟩ ↝ ⟨c'',s',l'⟩›
have "while (b) c' ⊢ ⟨c;;while (b) c',s,l + 2⟩ ↝ ⟨c'';;while (b) c',s',l' + 2⟩"
by(rule StepRecWhile)
moreover
from ‹labels c' l' c''› have "labels (while (b) c') (l' + 2) (c'';;while (b) c')"
by(rule Labels.Labels_WhileBody)
ultimately show ?case by simp blast
qed
next
case (Labels_WhileExit b c' c'')
from ‹⟨Skip,s⟩ → ⟨c'',s'⟩› have False by(auto elim:red.cases)
thus ?case by simp
qed
lemma reds_steps:
"⟦⟨c,s⟩ →* ⟨c',s'⟩; labels prog l c⟧
⟹ ∃l'. prog ⊢ ⟨c,s,l⟩ ↝* ⟨c',s',l'⟩ ∧ labels prog l' c'"
proof(induct rule:rtranclp_induct2)
case refl
from ‹labels prog l c› show ?case by blast
next
case (step c'' s'' c' s')
note IH = ‹labels prog l c ⟹
∃l'. prog ⊢ ⟨c,s,l⟩ ↝* ⟨c'',s'',l'⟩ ∧ labels prog l' c''›
from IH[OF ‹labels prog l c›] obtain l'' where "prog ⊢ ⟨c,s,l⟩ ↝* ⟨c'',s'',l''⟩"
and "labels prog l'' c''" by blast
from ‹labels prog l'' c''› ‹⟨c'',s''⟩ → ⟨c',s'⟩› obtain l'
where "prog ⊢ ⟨c'',s'',l''⟩ ↝ ⟨c',s',l'⟩"
and "labels prog l' c'" by(auto dest:red_step)
from ‹prog ⊢ ⟨c,s,l⟩ ↝* ⟨c'',s'',l''⟩› ‹prog ⊢ ⟨c'',s'',l''⟩ ↝ ⟨c',s',l'⟩›
have "prog ⊢ ⟨c,s,l⟩ ↝* ⟨c',s',l'⟩"
by(fastforce elim:rtranclp_trans)
with ‹labels prog l' c'› show ?case by blast
qed
subsubsection ‹The bisimulation theorem›
theorem reds_steps_bisimulation:
"labels prog l c ⟹ (⟨c,s⟩ →* ⟨c',s'⟩) =
(∃l'. prog ⊢ ⟨c,s,l⟩ ↝* ⟨c',s',l'⟩ ∧ labels prog l' c')"
by(fastforce intro:reds_steps elim:steps_reds)
end
Theory WEquivalence
section ‹Equivalence›
theory WEquivalence imports Semantics WCFG begin
subsection ‹From @{term "prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"} to\\
@{term "c ⊢ (_ l _) -et→ (_ l' _)"} with @{term transfers} and @{term preds}›
lemma Skip_WCFG_edge_Exit:
"⟦labels prog l Skip⟧ ⟹ prog ⊢ (_ l _) -⇑id→ (_Exit_)"
proof(induct prog l Skip rule:labels.induct)
case Labels_Base
show ?case by(fastforce intro:WCFG_Skip)
next
case (Labels_LAss V e)
show ?case by(rule WCFG_LAssSkip)
next
case (Labels_Seq2 c⇩2 l c⇩1)
from ‹c⇩2 ⊢ (_ l _) -⇑id→ (_Exit_)›
have "c⇩1;;c⇩2 ⊢ (_ l _) ⊕ #:c⇩1 -⇑id→ (_Exit_) ⊕ #:c⇩1"
by(fastforce intro:WCFG_SeqSecond)
thus ?case by(simp del:id_apply)
next
case (Labels_CondTrue c⇩1 l b c⇩2)
from ‹c⇩1 ⊢ (_ l _) -⇑id→ (_Exit_)›
have "if (b) c⇩1 else c⇩2 ⊢ (_ l _) ⊕ 1 -⇑id→ (_Exit_) ⊕ 1"
by(fastforce intro:WCFG_CondThen)
thus ?case by(simp del:id_apply)
next
case (Labels_CondFalse c⇩2 l b c⇩1)
from ‹c⇩2 ⊢ (_ l _) -⇑id→ (_Exit_)›
have "if (b) c⇩1 else c⇩2 ⊢ (_ l _) ⊕ (#:c⇩1 + 1) -⇑id→ (_Exit_) ⊕ (#:c⇩1 + 1)"
by(fastforce intro:WCFG_CondElse)
thus ?case by(simp del:id_apply)
next
case (Labels_WhileExit b c')
show ?case by(rule WCFG_WhileFalseSkip)
qed
lemma step_WCFG_edge:
assumes "prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"
obtains et where "prog ⊢ (_ l _) -et→ (_ l' _)" and "transfer et s = s'"
and "pred et s"
proof -
from ‹prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩›
have "∃et. prog ⊢ (_ l _) -et→ (_ l' _) ∧ transfer et s = s' ∧ pred et s"
proof(induct rule:step.induct)
case (StepLAss V e s)
have "pred ⇑(λs. s(V:=(interpret e s))) s" by simp
have "V:=e ⊢ (_0_) -⇑(λs. s(V:=(interpret e s)))→ (_1_)"
by(rule WCFG_LAss)
have "transfer ⇑(λs. s(V:=(interpret e s))) s = s(V:=(interpret e s))" by simp
with ‹pred ⇑(λs. s(V:=(interpret e s))) s›
‹V:=e ⊢ (_0_) -⇑(λs. s(V:=(interpret e s)))→ (_1_)› show ?case by blast
next
case (StepSeq c⇩1 c⇩2 l s)
from ‹labels (c⇩1;;c⇩2) l (Skip;;c⇩2)› ‹l < #:c⇩1› have "labels c⇩1 l Skip"
by(auto elim:labels.cases intro:Labels_Base)
hence "c⇩1 ⊢ (_ l _) -⇑id→ (_Exit_)"
by(fastforce intro:Skip_WCFG_edge_Exit)
hence "c⇩1;;c⇩2 ⊢ (_ l _) -⇑id→ (_0_) ⊕ #:c⇩1"
by(rule WCFG_SeqConnect,simp)
thus ?case by auto
next
case (StepSeqWhile b cx l s)
from ‹labels (while (b) cx) l (Skip;;while (b) cx)›
obtain lx where "labels cx lx Skip"
and [simp]:"l = lx + 2" by(auto elim:labels.cases)
hence "cx ⊢ (_ lx _) -⇑id→ (_Exit_)"
by(fastforce intro:Skip_WCFG_edge_Exit)
hence "while (b) cx ⊢ (_ lx _) ⊕ 2 -⇑id→ (_0_)"
by(fastforce intro:WCFG_WhileBodyExit)
thus ?case by auto
next
case (StepCondTrue b s c⇩1 c⇩2)
from ‹interpret b s = Some true›
have "pred (λs. interpret b s = Some true)⇩√ s" by simp
moreover
have "if (b) c⇩1 else c⇩2 ⊢ (_0_) -(λs. interpret b s = Some true)⇩√→ (_0_) ⊕ 1"
by(rule WCFG_CondTrue)
moreover
have "transfer (λs. interpret b s = Some true)⇩√ s = s" by simp
ultimately show ?case by auto
next
case (StepCondFalse b s c⇩1 c⇩2)
from ‹interpret b s = Some false›
have "pred (λs. interpret b s = Some false)⇩√ s" by simp
moreover
have "if (b) c⇩1 else c⇩2 ⊢ (_0_) -(λs. interpret b s = Some false)⇩√→
(_0_) ⊕ (#:c⇩1 + 1)"
by(rule WCFG_CondFalse)
moreover
have "transfer (λs. interpret b s = Some false)⇩√ s = s" by simp
ultimately show ?case by auto
next
case (StepWhileTrue b s c)
from ‹interpret b s = Some true›
have "pred (λs. interpret b s = Some true)⇩√ s" by simp
moreover
have "while (b) c ⊢ (_0_) -(λs. interpret b s = Some true)⇩√→ (_0_) ⊕ 2"
by(rule WCFG_WhileTrue)
moreover
have "transfer (λs. interpret b s = Some true)⇩√ s = s" by simp
ultimately show ?case by(auto simp del:add_2_eq_Suc')
next
case (StepWhileFalse b s c)
from ‹interpret b s = Some false›
have "pred (λs. interpret b s = Some false)⇩√ s" by simp
moreover
have "while (b) c ⊢ (_0_) -(λs. interpret b s = Some false)⇩√→ (_1_)"
by(rule WCFG_WhileFalse)
moreover
have "transfer (λs. interpret b s = Some false)⇩√ s = s" by simp
ultimately show ?case by auto
next
case (StepRecSeq1 prog c s l c' s' l' c⇩2)
from ‹∃et. prog ⊢ (_ l _) -et→ (_ l' _) ∧ transfer et s = s' ∧ pred et s›
obtain et where "prog ⊢ (_ l _) -et→ (_ l' _)"
and "transfer et s = s'" and "pred et s" by blast
moreover
from ‹prog ⊢ (_ l _) -et→ (_ l' _)› have "prog;;c⇩2 ⊢ (_ l _) -et→ (_ l' _)"
by(fastforce intro:WCFG_SeqFirst)
ultimately show ?case by blast
next
case (StepRecSeq2 prog c s l c' s' l' c⇩1)
from ‹∃et. prog ⊢ (_ l _) -et→ (_ l' _) ∧ transfer et s = s' ∧ pred et s›
obtain et where "prog ⊢ (_ l _) -et→ (_ l' _)"
and "transfer et s = s'" and "pred et s" by blast
moreover
from ‹prog ⊢ (_ l _) -et→ (_ l' _)›
have "c⇩1;;prog ⊢ (_ l _) ⊕ #:c⇩1 -et→ (_ l' _) ⊕ #:c⇩1"
by(fastforce intro:WCFG_SeqSecond)
ultimately show ?case by simp blast
next
case (StepRecCond1 prog c s l c' s' l' b c⇩2)
from ‹∃et. prog ⊢ (_ l _) -et→ (_ l' _) ∧ transfer et s = s' ∧ pred et s›
obtain et where "prog ⊢ (_ l _) -et→ (_ l' _)"
and "transfer et s = s'" and "pred et s" by blast
moreover
from ‹prog ⊢ (_ l _) -et→ (_ l' _)›
have "if (b) prog else c⇩2 ⊢ (_ l _) ⊕ 1 -et→ (_ l' _) ⊕ 1"
by(fastforce intro:WCFG_CondThen)
ultimately show ?case by simp blast
next
case (StepRecCond2 prog c s l c' s' l' b c⇩1)
from ‹∃et. prog ⊢ (_ l _) -et→ (_ l' _) ∧ transfer et s = s' ∧ pred et s›
obtain et where "prog ⊢ (_ l _) -et→ (_ l' _)"
and "transfer et s = s'" and "pred et s" by blast
moreover
from ‹prog ⊢ (_ l _) -et→ (_ l' _)›
have "if (b) c⇩1 else prog ⊢ (_ l _) ⊕ (#:c⇩1 + 1) -et→ (_ l' _) ⊕ (#:c⇩1 + 1)"
by(fastforce intro:WCFG_CondElse)
ultimately show ?case by simp blast
next
case (StepRecWhile cx c s l c' s' l' b)
from ‹∃et. cx ⊢ (_ l _) -et→ (_ l' _) ∧ transfer et s = s' ∧ pred et s›
obtain et where "cx ⊢ (_ l _) -et→ (_ l' _)"
and "transfer et s = s'" and "pred et s" by blast
moreover
hence "while (b) cx ⊢ (_ l _) ⊕ 2 -et→ (_ l' _) ⊕ 2"
by(fastforce intro:WCFG_WhileBody)
ultimately show ?case by simp blast
qed
with that show ?thesis by blast
qed
subsection ‹From @{term "c ⊢ (_ l _) -et→ (_ l' _)"} with @{term transfers}
and @{term preds} to\\
@{term "prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"}›
declare One_nat_def [simp del] add_2_eq_Suc' [simp del]
lemma WCFG_edge_Exit_Skip:
"⟦prog ⊢ n -et→ (_Exit_); n ≠ (_Entry_)⟧
⟹ ∃l. n = (_ l _) ∧ labels prog l Skip ∧ et = ⇑id"
proof(induct prog n et "(_Exit_)" rule:WCFG_induct)
case WCFG_Skip show ?case by(fastforce intro:Labels_Base)
next
case WCFG_LAssSkip show ?case by(fastforce intro:Labels_LAss)
next
case (WCFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹⟦n' = (_Exit_); n ≠ (_Entry_)⟧
⟹ ∃l. n = (_ l _) ∧ labels c⇩2 l Skip ∧ et = ⇑id›
from ‹n' ⊕ #:c⇩1 = (_Exit_)› have "n' = (_Exit_)" by(cases n') auto
from IH[OF this ‹n ≠ (_Entry_)›] obtain l where [simp]:"n = (_ l _)" "et = ⇑id"
and "labels c⇩2 l Skip" by blast
hence "labels (c⇩1;;c⇩2) (l + #:c⇩1) Skip" by(fastforce intro:Labels_Seq2)
thus ?case by(fastforce simp:id_def)
next
case (WCFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹⟦n' = (_Exit_); n ≠ (_Entry_)⟧
⟹ ∃l. n = (_ l _) ∧ labels c⇩1 l Skip ∧ et = ⇑id›
from ‹n' ⊕ 1 = (_Exit_)› have "n' = (_Exit_)" by(cases n') auto
from IH[OF this ‹n ≠ (_Entry_)›] obtain l where [simp]:"n = (_ l _)" "et = ⇑id"
and "labels c⇩1 l Skip" by blast
hence "labels (if (b) c⇩1 else c⇩2) (l + 1) Skip"
by(fastforce intro:Labels_CondTrue)
thus ?case by(fastforce simp:id_def)
next
case (WCFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹⟦n' = (_Exit_); n ≠ (_Entry_)⟧
⟹ ∃l. n = (_ l _) ∧ labels c⇩2 l Skip ∧ et = ⇑id›
from ‹n' ⊕ #:c⇩1 + 1 = (_Exit_)› have "n' = (_Exit_)" by(cases n') auto
from IH[OF this ‹n ≠ (_Entry_)›] obtain l where [simp]:"n = (_ l _)" "et = ⇑id"
and label:"labels c⇩2 l Skip" by blast
hence "labels (if (b) c⇩1 else c⇩2) (l + #:c⇩1 + 1) Skip"
by(fastforce intro:Labels_CondFalse)
thus ?case by(fastforce simp:add.assoc id_def)
next
case WCFG_WhileFalseSkip show ?case by(fastforce intro:Labels_WhileExit)
next
case (WCFG_WhileBody c' n et n' b) thus ?case by(cases n') auto
qed simp_all
lemma WCFG_edge_step:
"⟦prog ⊢ (_ l _) -et→ (_ l' _); transfer et s = s'; pred et s⟧
⟹ ∃c c'. prog ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels prog l c ∧ labels prog l' c'"
proof(induct prog "(_ l _)" et "(_ l' _)" arbitrary:l l' rule:WCFG_induct)
case (WCFG_LAss V e)
from ‹transfer ⇑λs. s(V:=(interpret e s)) s = s'›
have [simp]:"s' = s(V:=(interpret e s))" by(simp del:fun_upd_apply)
have "labels (V:=e) 0 (V:=e)" by(fastforce intro:Labels_Base)
moreover
hence "labels (V:=e) 1 Skip" by(fastforce intro:Labels_LAss)
ultimately show ?case
apply(rule_tac x="V:=e" in exI)
apply(rule_tac x="Skip" in exI)
by(fastforce intro:StepLAss simp del:fun_upd_apply)
next
case (WCFG_SeqFirst c⇩1 et c⇩2)
note IH = ‹⟦transfer et s = s'; pred et s⟧
⟹ ∃c c'. c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels c⇩1 l c ∧ labels c⇩1 l' c'›
from IH[OF ‹transfer et s = s'› ‹pred et s›]
obtain c c' where "c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"
and "labels c⇩1 l c" and "labels c⇩1 l' c'" by blast
from ‹c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩› have "c⇩1;;c⇩2 ⊢ ⟨c;;c⇩2,s,l⟩ ↝ ⟨c';;c⇩2,s',l'⟩"
by(rule StepRecSeq1)
moreover
from ‹labels c⇩1 l c› have "labels (c⇩1;;c⇩2) l (c;;c⇩2)"
by(fastforce intro:Labels_Seq1)
moreover
from ‹labels c⇩1 l' c'› have "labels (c⇩1;;c⇩2) l' (c';;c⇩2)"
by(fastforce intro:Labels_Seq1)
ultimately show ?case by blast
next
case (WCFG_SeqConnect c⇩1 et c⇩2)
from ‹c⇩1 ⊢ (_ l _) -et→ (_Exit_)›
have "labels c⇩1 l Skip" and [simp]:"et = ⇑id"
by(auto dest:WCFG_edge_Exit_Skip)
from ‹transfer et s = s'› have [simp]:"s' = s" by simp
have "labels c⇩2 0 c⇩2" by(fastforce intro:Labels_Base)
hence "labels (c⇩1;;c⇩2) #:c⇩1 c⇩2" by(fastforce dest:Labels_Seq2)
moreover
from ‹labels c⇩1 l Skip› have "labels (c⇩1;;c⇩2) l (Skip;;c⇩2)"
by(fastforce intro:Labels_Seq1)
moreover
from ‹labels c⇩1 l Skip› have "l < #:c⇩1" by(rule label_less_num_inner_nodes)
ultimately
have "c⇩1;;c⇩2 ⊢ ⟨Skip;;c⇩2,s,l⟩ ↝ ⟨c⇩2,s,#:c⇩1⟩" by -(rule StepSeq)
with ‹labels (c⇩1;;c⇩2) l (Skip;;c⇩2)›
‹labels (c⇩1;;c⇩2) #:c⇩1 c⇩2› ‹(_0_) ⊕ #:c⇩1 = (_ l' _)› show ?case by simp blast
next
case (WCFG_SeqSecond c⇩2 n et n' c⇩1)
note IH = ‹⋀l l'. ⟦n = (_ l _); n' = (_ l' _); transfer et s = s'; pred et s⟧
⟹ ∃c c'. c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels c⇩2 l c ∧ labels c⇩2 l' c'›
from ‹n ⊕ #:c⇩1 = (_ l _)› obtain lx where "n = (_ lx _)"
and [simp]:"l = lx + #:c⇩1"
by(cases n) auto
from ‹n' ⊕ #:c⇩1 = (_ l' _)› obtain lx' where "n' = (_ lx' _)"
and [simp]:"l' = lx' + #:c⇩1"
by(cases n') auto
from IH[OF ‹n = (_ lx _)› ‹n' = (_ lx' _)› ‹transfer et s = s'› ‹pred et s›]
obtain c c' where "c⇩2 ⊢ ⟨c,s,lx⟩ ↝ ⟨c',s',lx'⟩"
and "labels c⇩2 lx c" and "labels c⇩2 lx' c'" by blast
from ‹c⇩2 ⊢ ⟨c,s,lx⟩ ↝ ⟨c',s',lx'⟩› have "c⇩1;;c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"
by(fastforce intro:StepRecSeq2)
moreover
from ‹labels c⇩2 lx c› have "labels (c⇩1;;c⇩2) l c" by(fastforce intro:Labels_Seq2)
moreover
from ‹labels c⇩2 lx' c'› have "labels (c⇩1;;c⇩2) l' c'" by(fastforce intro:Labels_Seq2)
ultimately show ?case by blast
next
case (WCFG_CondTrue b c⇩1 c⇩2)
from ‹(_0_) ⊕ 1 = (_ l' _)› have [simp]:"l' = 1" by simp
from ‹transfer (λs. interpret b s = Some true)⇩√ s = s'› have [simp]:"s' = s" by simp
have "labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)"
by(fastforce intro:Labels_Base)
have "labels c⇩1 0 c⇩1" by(fastforce intro:Labels_Base)
hence "labels (if (b) c⇩1 else c⇩2) 1 c⇩1" by(fastforce dest:Labels_CondTrue)
from ‹pred (λs. interpret b s = Some true)⇩√ s›
have "interpret b s = Some true" by simp
hence "if (b) c⇩1 else c⇩2 ⊢ ⟨if (b) c⇩1 else c⇩2,s,0⟩ ↝ ⟨c⇩1,s,1⟩"
by(rule StepCondTrue)
with ‹labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)›
‹labels (if (b) c⇩1 else c⇩2) 1 c⇩1› show ?case by simp blast
next
case (WCFG_CondFalse b c⇩1 c⇩2)
from ‹(_0_) ⊕ #:c⇩1 + 1 = (_ l' _)› have [simp]:"l' = #:c⇩1 + 1" by simp
from ‹transfer (λs. interpret b s = Some false)⇩√ s = s'› have [simp]:"s' = s"
by simp
have "labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)"
by(fastforce intro:Labels_Base)
have "labels c⇩2 0 c⇩2" by(fastforce intro:Labels_Base)
hence "labels (if (b) c⇩1 else c⇩2) (#:c⇩1 + 1) c⇩2" by(fastforce dest:Labels_CondFalse)
from ‹pred (λs. interpret b s = Some false)⇩√ s›
have "interpret b s = Some false" by simp
hence "if (b) c⇩1 else c⇩2 ⊢ ⟨if (b) c⇩1 else c⇩2,s,0⟩ ↝ ⟨c⇩2,s,#:c⇩1 + 1⟩"
by(rule StepCondFalse)
with ‹labels (if (b) c⇩1 else c⇩2) 0 (if (b) c⇩1 else c⇩2)›
‹labels (if (b) c⇩1 else c⇩2) (#:c⇩1 + 1) c⇩2› show ?case by simp blast
next
case (WCFG_CondThen c⇩1 n et n' b c⇩2)
note IH = ‹⋀l l'. ⟦n = (_ l _); n' = (_ l' _); transfer et s = s'; pred et s⟧
⟹ ∃c c'. c⇩1 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels c⇩1 l c ∧ labels c⇩1 l' c'›
from ‹n ⊕ 1 = (_ l _)› obtain lx where "n = (_ lx _)" and [simp]:"l = lx + 1"
by(cases n) auto
from ‹n' ⊕ 1 = (_ l' _)› obtain lx' where "n' = (_ lx' _)" and [simp]:"l' = lx' + 1"
by(cases n') auto
from IH[OF ‹n = (_ lx _)› ‹n' = (_ lx' _)› ‹transfer et s = s'› ‹pred et s›]
obtain c c' where "c⇩1 ⊢ ⟨c,s,lx⟩ ↝ ⟨c',s',lx'⟩"
and "labels c⇩1 lx c" and "labels c⇩1 lx' c'" by blast
from ‹c⇩1 ⊢ ⟨c,s,lx⟩ ↝ ⟨c',s',lx'⟩› have "if (b) c⇩1 else c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"
by(fastforce intro:StepRecCond1)
moreover
from ‹labels c⇩1 lx c› have "labels (if (b) c⇩1 else c⇩2) l c"
by(fastforce intro:Labels_CondTrue)
moreover
from ‹labels c⇩1 lx' c'› have "labels (if (b) c⇩1 else c⇩2) l' c'"
by(fastforce intro:Labels_CondTrue)
ultimately show ?case by blast
next
case (WCFG_CondElse c⇩2 n et n' b c⇩1)
note IH = ‹⋀l l'. ⟦n = (_ l _); n' = (_ l' _); transfer et s = s'; pred et s⟧
⟹ ∃c c'. c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels c⇩2 l c ∧ labels c⇩2 l' c'›
from ‹n ⊕ #:c⇩1 + 1 = (_ l _)› obtain lx where "n = (_ lx _)"
and [simp]:"l = lx + #:c⇩1 + 1"
by(cases n) auto
from ‹n' ⊕ #:c⇩1 + 1 = (_ l' _)› obtain lx' where "n' = (_ lx' _)"
and [simp]:"l' = lx' + #:c⇩1 + 1"
by(cases n') auto
from IH[OF ‹n = (_ lx _)› ‹n' = (_ lx' _)› ‹transfer et s = s'› ‹pred et s›]
obtain c c' where "c⇩2 ⊢ ⟨c,s,lx⟩ ↝ ⟨c',s',lx'⟩"
and "labels c⇩2 lx c" and "labels c⇩2 lx' c'" by blast
from ‹c⇩2 ⊢ ⟨c,s,lx⟩ ↝ ⟨c',s',lx'⟩› have "if (b) c⇩1 else c⇩2 ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩"
by(fastforce intro:StepRecCond2)
moreover
from ‹labels c⇩2 lx c› have "labels (if (b) c⇩1 else c⇩2) l c"
by(fastforce intro:Labels_CondFalse)
moreover
from ‹labels c⇩2 lx' c'› have "labels (if (b) c⇩1 else c⇩2) l' c'"
by(fastforce intro:Labels_CondFalse)
ultimately show ?case by blast
next
case (WCFG_WhileTrue b cx)
from ‹(_0_) ⊕ 2 = (_ l' _)› have [simp]:"l' = 2" by simp
from ‹transfer (λs. interpret b s = Some true)⇩√ s = s'› have [simp]:"s' = s" by simp
have "labels (while (b) cx) 0 (while (b) cx)"
by(fastforce intro:Labels_Base)
have "labels cx 0 cx" by(fastforce intro:Labels_Base)
hence "labels (while (b) cx) 2 (cx;;while (b) cx)"
by(fastforce dest:Labels_WhileBody)
from ‹pred (λs. interpret b s = Some true)⇩√ s› have "interpret b s = Some true" by simp
hence "while (b) cx ⊢ ⟨while (b) cx,s,0⟩ ↝ ⟨cx;;while (b) cx,s,2⟩"
by(rule StepWhileTrue)
with ‹labels (while (b) cx) 0 (while (b) cx)›
‹labels (while (b) cx) 2 (cx;;while (b) cx)› show ?case by simp blast
next
case (WCFG_WhileFalse b cx)
from ‹transfer (λs. interpret b s = Some false)⇩√ s = s'› have [simp]:"s' = s"
by simp
have "labels (while (b) cx) 0 (while (b) cx)" by(fastforce intro:Labels_Base)
have "labels (while (b) cx) 1 Skip" by(fastforce intro:Labels_WhileExit)
from ‹pred (λs. interpret b s = Some false)⇩√ s› have "interpret b s = Some false"
by simp
hence "while (b) cx ⊢ ⟨while (b) cx,s,0⟩ ↝ ⟨Skip,s,1⟩"
by(rule StepWhileFalse)
with ‹labels (while (b) cx) 0 (while (b) cx)› ‹labels (while (b) cx) 1 Skip›
show ?case by simp blast
next
case (WCFG_WhileBody cx n et n' b)
note IH = ‹⋀l l'. ⟦n = (_ l _); n' = (_ l' _); transfer et s = s'; pred et s⟧
⟹ ∃c c'. cx ⊢ ⟨c,s,l⟩ ↝ ⟨c',s',l'⟩ ∧ labels cx l c ∧ labels cx l' c'›
from ‹n ⊕ 2 = (_ l _)› obtain lx where "n = (_ lx _)" and [simp]:"l = lx + 2"
by(cases n) auto
from ‹n' ⊕ 2 = (_ l' _)› obtain lx' where "n' = (_ lx' _)"
and [simp]:"l' = lx' + 2" by(cases n') auto
from IH[OF ‹n = (_ lx _)› ‹n' = (_ lx' _)› ‹transfer et s = s'› ‹pred et s›]
obtain c c' where "cx ⊢ ⟨c,s,lx⟩ ↝ ⟨c',s',lx'⟩"
and "labels cx lx c" and "labels cx lx' c'" by blast
hence "while (b) cx ⊢ ⟨c;;while (b) cx,s,l⟩ ↝ ⟨c';;while (b) cx,s',l'⟩"
by(fastforce intro:StepRecWhile)
moreover
from ‹labels cx lx c› have "labels (while (b) cx) l (c;;while (b) cx)"
by(fastforce intro:Labels_WhileBody)
moreover
from ‹labels cx lx' c'› have "labels (while (b) cx) l' (c';;while (b) cx)"
by(fastforce intro:Labels_WhileBody)
ultimately show ?case by blast
next
case (WCFG_WhileBodyExit cx n et b)
from ‹n ⊕ 2 = (_ l _)› obtain lx where [simp]:"n = (_ lx _)" and [simp]:"l = lx + 2"
by(cases n) auto
from ‹cx ⊢ n -et→ (_Exit_)› have "labels cx lx Skip" and [simp]:"et = ⇑id"
by(auto dest:WCFG_edge_Exit_Skip)
from ‹transfer et s = s'› have [simp]:"s' = s" by simp
from ‹labels cx lx Skip› have "labels (while (b) cx) l (Skip;;while (b) cx)"
by(fastforce intro:Labels_WhileBody)
hence "while (b) cx ⊢ ⟨Skip;;while (b) cx,s,l⟩ ↝ ⟨while (b) cx,s,0⟩"
by(rule StepSeqWhile)
moreover
have "labels (while (b) cx) 0 (while (b) cx)"
by(fastforce intro:Labels_Base)
ultimately show ?case
using ‹labels (while (b) cx) l (Skip;;while (b) cx)› by simp blast
qed
end
Theory StaticControlDependences
section ‹Interpretations of the various static control dependences›
theory StaticControlDependences imports
AdditionalLemmas
SemanticsWellFormed
begin
lemma WhilePostdomination_aux:
"Postdomination sourcenode targetnode kind (valid_edge prog) Entry Exit"
proof(unfold_locales)
fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
thus "∃as. prog ⊢ (_Entry_) -as→* n" by(rule valid_node_Entry_path)
next
fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
thus "∃as. prog ⊢ n -as→* (_Exit_)" by(rule valid_node_Exit_path)
qed
interpretation WhilePostdomination:
Postdomination sourcenode targetnode kind "valid_edge prog" Entry Exit
by(rule WhilePostdomination_aux)
lemma WhileStrongPostdomination_aux:
"StrongPostdomination sourcenode targetnode kind (valid_edge prog) Entry Exit"
proof(unfold_locales)
fix n assume "CFG.valid_node sourcenode targetnode (valid_edge prog) n"
hence "valid_node prog n" by(simp add:valid_node_def While_CFG.valid_node_def)
show "finite {n'. ∃a'. valid_edge prog a' ∧ sourcenode a' = n ∧
targetnode a' = n'}"
by(rule finite_successors)
qed
interpretation WhileStrongPostdomination:
StrongPostdomination sourcenode targetnode kind "valid_edge prog" Entry Exit
by(rule WhileStrongPostdomination_aux)
subsection ‹Standard Control Dependence›
lemma WStandardControlDependence_aux:
"StandardControlDependencePDG sourcenode targetnode kind (valid_edge prog)
Entry (Defs prog) (Uses prog) id Exit"
by(unfold_locales)
interpretation WStandardControlDependence:
StandardControlDependencePDG sourcenode targetnode kind "valid_edge prog"
Entry "Defs prog" "Uses prog" id Exit
by(rule WStandardControlDependence_aux)
lemma Fundamental_property_scd_aux: "BackwardSlice_wf sourcenode targetnode kind
(valid_edge prog) Entry (Defs prog) (Uses prog) id
(WStandardControlDependence.PDG_BS_s prog) reds (labels_nodes prog)"
proof -
interpret BackwardSlice sourcenode targetnode kind "valid_edge prog" Entry
"Defs prog" "Uses prog" id
"StandardControlDependencePDG.PDG_BS_s sourcenode targetnode
(valid_edge prog) (Defs prog) (Uses prog) Exit"
by(rule WStandardControlDependence.PDGBackwardSliceCorrect)
show ?thesis by(unfold_locales)
qed
interpretation Fundamental_property_scd: BackwardSlice_wf sourcenode targetnode kind
"valid_edge prog" Entry "Defs prog" "Uses prog" id
"WStandardControlDependence.PDG_BS_s prog" reds "labels_nodes prog"
by(rule Fundamental_property_scd_aux)
subsection ‹Weak Control Dependence›
lemma WWeakControlDependence_aux:
"WeakControlDependencePDG sourcenode targetnode kind (valid_edge prog)
Entry (Defs prog) (Uses prog) id Exit"
by(unfold_locales)
interpretation WWeakControlDependence:
WeakControlDependencePDG sourcenode targetnode kind "valid_edge prog"
Entry "Defs prog" "Uses prog" id Exit
by(rule WWeakControlDependence_aux)
lemma Fundamental_property_wcd_aux: "BackwardSlice_wf sourcenode targetnode kind
(valid_edge prog) Entry (Defs prog) (Uses prog) id
(WWeakControlDependence.PDG_BS_w prog) reds (labels_nodes prog)"
proof -
interpret BackwardSlice sourcenode targetnode kind "valid_edge prog" Entry
"Defs prog" "Uses prog" id
"WeakControlDependencePDG.PDG_BS_w sourcenode targetnode
(valid_edge prog) (Defs prog) (Uses prog) Exit"
by(rule WWeakControlDependence.WeakPDGBackwardSliceCorrect)
show ?thesis by(unfold_locales)
qed
interpretation Fundamental_property_wcd: BackwardSlice_wf sourcenode targetnode kind
"valid_edge prog" Entry "Defs prog" "Uses prog" id
"WWeakControlDependence.PDG_BS_w prog" reds "labels_nodes prog"
by(rule Fundamental_property_wcd_aux)
subsection ‹Weak Order Dependence›
lemma Fundamental_property_wod_aux: "BackwardSlice_wf sourcenode targetnode kind
(valid_edge prog) Entry (Defs prog) (Uses prog) id
(While_CFG_wf.wod_backward_slice prog) reds (labels_nodes prog)"
proof -
interpret BackwardSlice sourcenode targetnode kind "valid_edge prog" Entry
"Defs prog" "Uses prog" id
"CFG_wf.wod_backward_slice sourcenode targetnode (valid_edge prog)
(Defs prog) (Uses prog)"
by(rule While_CFG_wf.WODBackwardSliceCorrect)
show ?thesis by(unfold_locales)
qed
interpretation Fundamental_property_wod: BackwardSlice_wf sourcenode targetnode kind
"valid_edge prog" Entry "Defs prog" "Uses prog" id
"While_CFG_wf.wod_backward_slice prog" reds "labels_nodes prog"
by(rule Fundamental_property_wod_aux)
end
Theory JVMCFG
chapter ‹A Control Flow Graph for Jinja Byte Code›
section ‹Formalizing the CFG›
theory JVMCFG imports "../Basic/BasicDefs" Jinja.BVExample begin
declare lesub_list_impl_same_size [simp del]
declare listE_length [simp del]
subsection ‹Type definitions›
subsubsection ‹Wellformed Programs›
definition "wf_jvmprog = {(P, Phi). wf_jvm_prog⇘Phi⇙ P}"
typedef wf_jvmprog = wf_jvmprog
proof
show "(E, Phi) ∈ wf_jvmprog"
unfolding wf_jvmprog_def by (auto intro: wf_prog)
qed
hide_const Phi E
abbreviation rep_jvmprog_jvm_prog :: "wf_jvmprog ⇒ jvm_prog"
("_⇘wf⇙")
where "P⇘wf⇙ ≡ fst(Rep_wf_jvmprog(P))"
abbreviation rep_jvmprog_phi :: "wf_jvmprog ⇒ ty⇩P"
("_⇘Φ⇙")
where "P⇘Φ⇙ ≡ snd(Rep_wf_jvmprog(P))"
lemma wf_jvmprog_is_wf: "wf_jvm_prog⇘P⇘Φ⇙⇙ (P⇘wf⇙)"
using Rep_wf_jvmprog [of P]
by (auto simp: wf_jvmprog_def split_beta)
subsubsection ‹Basic Types›
text ‹
We consider a program to be a well-formed Jinja program,
together with a given base class and a main method
›
type_synonym jvmprog = "wf_jvmprog × cname × mname"
type_synonym callstack = "(cname × mname × pc) list"
text ‹
The state is modeled as $\textrm{heap} \times \textrm{stack-variables} \times \textrm{local-variables}$
stack and local variables are modeled as pairs of natural numbers. The first number
gives the position in the call stack (i.e. the method in which the variable is used),
the second the position in the method's stack or array of local variables resp.
The stack variables are numbered from bottom up (which is the reverse order of the
array for the stack in Jinja's state representation), whereas local variables are identified
by their position in the array of local variables of Jinja's state representation.
›
type_synonym state = "heap × ((nat × nat) ⇒ val) × ((nat × nat) ⇒ val)"
abbreviation heap_of :: "state ⇒ heap"
where
"heap_of s ≡ fst(s)"
abbreviation stk_of :: "state ⇒ ((nat × nat) ⇒ val)"
where
"stk_of s ≡ fst(snd(s))"
abbreviation loc_of :: "state ⇒ ((nat × nat) ⇒ val)"
where
"loc_of s ≡ snd(snd(s))"
subsection ‹Basic Definitions›
subsubsection ‹State update (instruction execution)›
text ‹
This function models instruction execution for our state representation.
Additional parameters are the call depth of the current program point,
the stack length of the current program point,
the length of the stack in the underlying call frame (needed for {\sc Return}),
and (for {\sc Invoke}) the length of the array of local variables of the invoked method.
Exception handling is not covered by this function.
›
fun exec_instr :: "instr ⇒ wf_jvmprog ⇒ state ⇒ nat ⇒ nat ⇒ nat ⇒ nat ⇒ state"
where
exec_instr_Load:
"exec_instr (Load n) P s calldepth stk_length rs ill =
(let (h,stk,loc) = s
in (h, stk((calldepth,stk_length):=loc(calldepth,n)), loc))"
| exec_instr_Store:
"exec_instr (Store n) P s calldepth stk_length rs ill =
(let (h,stk,loc) = s
in (h, stk, loc((calldepth,n):=stk(calldepth,stk_length - 1))))"
| exec_instr_Push:
"exec_instr (Push v) P s calldepth stk_length rs ill =
(let (h,stk,loc) = s
in (h, stk((calldepth,stk_length):=v), loc))"
| exec_instr_New:
"exec_instr (New C) P s calldepth stk_length rs ill =
(let (h,stk,loc) = s;
a = the(new_Addr h)
in (h(a ↦ (blank (P⇘wf⇙) C)), stk((calldepth,stk_length):=Addr a), loc))"
| exec_instr_Getfield:
"exec_instr (Getfield F C) P s calldepth stk_length rs ill =
(let (h,stk,loc) = s;
a = the_Addr (stk (calldepth,stk_length - 1));
(D,fs) = the(h a)
in (h, stk((calldepth,stk_length - 1) := the(fs(F,C))), loc))"
| exec_instr_Putfield:
"exec_instr (Putfield F C) P s calldepth stk_length rs ill =
(let (h,stk,loc) = s;
v = stk (calldepth,stk_length - 1);
a = the_Addr (stk (calldepth,stk_length - 2));
(D,fs) = the(h a)
in (h(a ↦ (D,fs((F,C) ↦ v))), stk, loc))"
| exec_instr_Checkcast:
"exec_instr (Checkcast C) P s calldepth stk_length rs ill = s"
| exec_instr_Pop:
"exec_instr (Pop) P s calldepth stk_length rs ill = s"
| exec_instr_IAdd:
"exec_instr (IAdd) P s calldepth stk_length rs ill =
(let (h,stk,loc) = s;
i⇩1 = the_Intg (stk (calldepth, stk_length - 1));
i⇩2 = the_Intg (stk (calldepth, stk_length - 2))
in (h, stk((calldepth, stk_length - 2) := Intg (i⇩1 + i⇩2)), loc))"
| exec_instr_IfFalse:
"exec_instr (IfFalse b) P s calldepth stk_length rs ill = s"
| exec_instr_CmpEq:
"exec_instr (CmpEq) P s calldepth stk_length rs ill =
(let (h,stk,loc) = s;
v⇩1 = stk (calldepth, stk_length - 1);
v⇩2 = stk (calldepth, stk_length - 2)
in (h, stk((calldepth, stk_length - 2) := Bool (v⇩1 = v⇩2)), loc))"
| exec_instr_Goto:
"exec_instr (Goto i) P s calldepth stk_length rs ill = s"
| exec_instr_Throw:
"exec_instr (Throw) P s calldepth stk_length rs ill = s"
| exec_instr_Invoke:
"exec_instr (Invoke M n) P s calldepth stk_length rs invoke_loc_length =
(let (h,stk,loc) = s;
loc' = (λ(a,b). if (a ≠ Suc calldepth ∨ b ≥ invoke_loc_length) then loc(a,b) else
(if (b ≤ n) then stk(calldepth, stk_length - (Suc n - b)) else arbitrary))
in (h,stk,loc'))"
| exec_instr_Return:
"exec_instr (Return) P s calldepth stk_length ret_stk_length ill =
(if (calldepth = 0)
then s
else
(let (h,stk,loc) = s;
v = stk(calldepth, stk_length - 1)
in (h,stk((calldepth - 1, ret_stk_length - 1) := v),loc))
)"
subsubsection ‹length of stack and local variables›
text ‹The following terms extract the stack length at a given program point
from the well-typing of the given program›
abbreviation stkLength :: "wf_jvmprog ⇒ cname ⇒ mname ⇒ pc ⇒ nat"
where
"stkLength P C M pc ≡ length (fst(the(((P⇘Φ⇙) C M)!pc)))"
abbreviation locLength :: "wf_jvmprog ⇒ cname ⇒ mname ⇒ pc ⇒ nat"
where
"locLength P C M pc ≡ length (snd(the(((P⇘Φ⇙) C M)!pc)))"
subsubsection ‹Conversion functions›
text ‹
This function takes a natural number n and a function f with domain ‹nat›
and creates the array [f 0, f 1, f 2, ..., f (n - 1)].
This is used for extracting the array of local variables
›
abbreviation locs :: "nat ⇒ (nat ⇒ 'a) ⇒ 'a list"
where "locs n loc ≡ map loc [0..<n]"
text ‹
This function takes a natural number n and a function f with domain ‹nat›
and creates the array [f (n - 1), ..., f 1, f 0].
This is used for extracting the stack as a list
›
abbreviation stks :: "nat ⇒ (nat ⇒ 'a) ⇒ 'a list"
where "stks n stk ≡ map stk (rev [0..<n])"
text ‹
This function creates a list of the arrays for local variables from the given state
corresponding to the given callstack
›
fun locss :: "wf_jvmprog ⇒ callstack ⇒ ((nat × nat) ⇒ 'a) ⇒ 'a list list"
where
"locss P [] loc = []"
| "locss P ((C,M,pc)#cs) loc =
(locs (locLength P C M pc) (λa. loc (length cs, a)))#(locss P cs loc)"
text ‹
This function creates a list of the (methods') stacks from the given state
corresponding to the given callstack
›
fun stkss :: "wf_jvmprog ⇒ callstack ⇒ ((nat × nat) ⇒ 'a) ⇒ 'a list list"
where
"stkss P [] stk = []"
| "stkss P ((C,M,pc)#cs) stk =
(stks (stkLength P C M pc) (λa. stk (length cs, a)))#(stkss P cs stk)"
text ‹Given a callstack and a state, this abbreviation converts the state
to Jinja's state representation
›
abbreviation state_to_jvm_state :: "wf_jvmprog ⇒ callstack ⇒ state ⇒ jvm_state"
where "state_to_jvm_state P cs s ≡
(None, heap_of s, zip (stkss P cs (stk_of s)) (zip (locss P cs (loc_of s)) cs))"
text ‹This function extracts the call stack from a given frame stack (as it is given
by Jinja's state representation)
›
definition framestack_to_callstack :: "frame list ⇒ callstack"
where "framestack_to_callstack frs ≡ map snd (map snd frs)"
subsubsection ‹State Conformance›
text ‹Now we lift byte code verifier conformance to our state representation›
definition bv_conform :: "wf_jvmprog ⇒ callstack ⇒ state ⇒ bool"
("_,_ ⊢⇘BV⇙ _ √")
where "P,cs ⊢⇘BV⇙ s √ ≡ correct_state (P⇘wf⇙) (P⇘Φ⇙) (state_to_jvm_state P cs s)"
subsubsection ‹Statically determine catch-block›
text ‹This function is equivalent to Jinja's ‹find_handler› function›
fun find_handler_for :: "wf_jvmprog ⇒ cname ⇒ callstack ⇒ callstack"
where
"find_handler_for P C [] = []"
| "find_handler_for P C (c#cs) = (let (C',M',pc') = c in
(case match_ex_table (P⇘wf⇙) C pc' (ex_table_of (P⇘wf⇙) C' M') of
None ⇒ find_handler_for P C cs
| Some pc_d ⇒ (C', M', fst pc_d)#cs))"
subsection ‹Simplification lemmas›
lemma find_handler_decr [simp]: "find_handler_for P Exc cs ≠ c#cs"
proof
assume "find_handler_for P Exc cs = c#cs"
hence "length cs < length (find_handler_for P Exc cs)" by simp
thus False by (induct cs, auto)
qed
lemma stkss_length [simp]: "length (stkss P cs stk) = length cs"
by (induct cs) auto
lemma locss_length [simp]: "length (locss P cs loc) = length cs"
by (induct cs) auto
lemma nth_stkss:
"⟦ a < length cs; b < length (stkss P cs stk ! (length cs - Suc a)) ⟧
⟹ stkss P cs stk ! (length cs - Suc a) !
(length (stkss P cs stk ! (length cs - Suc a)) - Suc b) = stk (a,b)"
proof (induct cs)
case Nil
thus ?case by (simp add: nth_Cons')
next
case (Cons aa cs)
thus ?case
by (cases aa, auto simp add: nth_Cons' rev_nth less_Suc_eq)
qed
lemma nth_locss:
"⟦ a < length cs; b < length (locss P cs loc ! (length cs - Suc a)) ⟧
⟹ locss P cs loc ! (length cs - Suc a) ! b = loc (a,b)"
proof (induct cs)
case Nil
thus ?case by (simp add: nth_Cons')
next
case (Cons aa cs)
thus ?case
by (cases aa, auto simp: nth_Cons' less_Suc_eq)
qed
lemma hd_stks [simp]: "n ≠ 0 ⟹ hd (stks n stk) = stk(n - 1)"
by (cases n, simp_all)
lemma hd_tl_stks: "n > 1 ⟹ hd (tl (stks n stk)) = stk(n - 2)"
by (cases n, auto)
lemma stkss_purge:
"length cs ≤ a ⟹ stkss P cs (stk((a,b) := c)) = stkss P cs stk"
by (induct cs, auto )
lemma stkss_purge':
"length cs ≤ a ⟹ stkss P cs (λs. if s = (a, b) then c else stk s) = stkss P cs stk"
by (fold fun_upd_def, simp only: stkss_purge)
lemma locss_purge:
"length cs ≤ a ⟹ locss P cs (loc((a,b) := c)) = locss P cs loc"
by (induct cs, auto )
lemma locss_purge':
"length cs ≤ a ⟹ locss P cs (λs. if s = (a, b) then c else loc s) = locss P cs loc"
by (fold fun_upd_def, simp only: locss_purge)
lemma locs_pullout [simp]:
"locs b (loc(n := e)) = (locs b loc) [n := e]"
proof (induct b)
case 0
thus ?case by simp
next
case (Suc b)
thus ?case
by (cases "n - b", auto simp: list_update_append not_less_eq less_Suc_eq)
qed
lemma locs_pullout' [simp]:
"locs b (λa. if a = n then e else loc (c, a)) = (locs b (λa. loc (c, a))) [n := e]"
by (fold fun_upd_def) simp
lemma stks_pullout:
"n < b ⟹ stks b (stk(n := e)) = (stks b stk) [b - Suc n := e]"
proof (induct b)
case 0
thus ?case by simp
next
case (Suc b)
thus ?case
proof (cases "b = n")
case True
with Suc show ?thesis
by auto
next
case False
with Suc show ?thesis
by (cases "b - n") (auto intro!: nth_equalityI simp: nth_list_update)
qed
qed
lemma nth_tl : "xs ≠ [] ⟹ tl xs ! n = xs ! (Suc n)"
by (cases xs, simp_all)
lemma f2c_Nil [simp]: "framestack_to_callstack [] = []"
by (simp add: framestack_to_callstack_def)
lemma f2c_Cons [simp]:
"framestack_to_callstack ((stk,loc,C,M,pc)#frs) = (C,M,pc)#(framestack_to_callstack frs)"
by (simp add: framestack_to_callstack_def)
lemma f2c_length [simp]:
"length (framestack_to_callstack frs) = length frs"
by (simp add: framestack_to_callstack_def)
lemma f2c_s2jvm_id [simp]:
"framestack_to_callstack
(snd(snd(state_to_jvm_state P cs s))) =
cs"
by (cases s, simp add: framestack_to_callstack_def)
lemma f2c_s2jvm_id' [simp]:
"framestack_to_callstack
(zip (stkss P cs stk) (zip (locss P cs loc) cs)) = cs"
by (simp add: framestack_to_callstack_def)
lemma f2c_append [simp]:
"framestack_to_callstack (frs @ frs') =
(framestack_to_callstack frs) @ (framestack_to_callstack frs')"
by (simp add: framestack_to_callstack_def)
subsection ‹CFG construction›
subsection ‹Datatypes›
text ‹Nodes are labeled with a callstack and an optional tuple (consisting of
a callstack and a flag).
The first callstack determines the current program point (i.e. the next statement
to execute). If the second parameter is not None, we are at an intermediate state,
where the target of the instruction is determined (the second callstack)
and the flag is set to whether an exception is thrown or not.
›
datatype j_node =
Entry ("'('_Entry'_')")
| Node "callstack" "(callstack × bool) option" ("'('_ _,_ '_')")
text ‹The empty callstack indicates the exit node›
abbreviation j_node_Exit :: "j_node" ("'('_Exit'_')")
where "j_node_Exit ≡ (_ [],None _)"
text ‹An edge is a triple, consisting of two nodes and the edge kind›
type_synonym j_edge = "(j_node × state edge_kind × j_node)"
subsection ‹CFG›
text ‹
The CFG is constructed by a case analysis on the instructions and
their different behavior in different states. E.g. the exceptional behavior of
{\sc New}, if there is no more space in the heap, vs. the normal behavior.
Note: The set of edges defined by this predicate is a first approximation to the
real set of edges in the CFG. We later (theory JVMInterpretation) add some well-formedness
requirements to the nodes.
›
inductive JVM_CFG :: "jvmprog ⇒ j_node ⇒ state edge_kind ⇒ j_node ⇒ bool"
("_ ⊢ _ -_→ _")
where
JCFG_EntryExit:
"prog ⊢ (_Entry_) -(λs. False)⇩√→ (_Exit_)"
| JCFG_EntryStart:
"prog = (P, C0, Main) ⟹ prog ⊢ (_Entry_) -(λs. True)⇩√→ (_ [(C0, Main, 0)],None _)"
| JCFG_ReturnExit:
"⟦ prog = (P,C0,Main);
(instrs_of (P⇘wf⇙) C M) ! pc = Return ⟧
⟹ prog ⊢ (_ [(C, M, pc)],None _) -⇑id→ (_Exit_)"
| JCFG_Straight_NoExc:
"⟦ prog = (P, C0, Main);
instrs_of (P⇘wf⇙) C M ! pc ∈ {Load idx, Store idx, Push val, Pop, IAdd, CmpEq};
ek = ⇑(λs. exec_instr ((instrs_of (P⇘wf⇙) C M) ! pc) P s
(length cs) (stkLength P C M pc) arbitrary arbitrary) ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, Suc pc)#cs,None _)"
| JCFG_New_Normal_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (New Cl);
ek = (λ(h,stk,loc). new_Addr h ≠ None)⇩√⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊((C, M, Suc pc)#cs,False)⌋ _)"
| JCFG_New_Normal_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (New Cl);
ek = ⇑(λs. exec_instr (New Cl) P s (length cs) (stkLength P C M pc) arbitrary arbitrary) ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((C, M, Suc pc)#cs, False)⌋ _) -ek→ (_ (C, M, Suc pc)#cs,None _)"
| JCFG_New_Exc_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (New Cl);
find_handler_for P OutOfMemory ((C, M, pc)#cs) = cs';
ek = (λ(h,stk,loc). new_Addr h = None)⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊(cs',True)⌋ _)"
| JCFG_New_Exc_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (New Cl);
find_handler_for P OutOfMemory ((C, M, pc)#cs) = (C', M', pc')#cs';
ek = ⇑(λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt OutOfMemory)),
loc)
) ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((C', M', pc')#cs', True)⌋ _) -ek→ (_ (C', M', pc')#cs',None _)"
| JCFG_New_Exc_Exit:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (New Cl);
find_handler_for P OutOfMemory ((C, M, pc)#cs) = [] ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊([], True)⌋ _) -⇑id→ (_Exit_)"
| JCFG_Getfield_Normal_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Getfield Fd Cl);
ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1) ≠ Null)⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊((C, M, Suc pc)#cs, False)⌋ _)"
| JCFG_Getfield_Normal_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Getfield Fd Cl);
ek = ⇑(λs. exec_instr (Getfield Fd Cl) P s (length cs) (stkLength P C M pc)
arbitrary arbitrary) ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((C, M, Suc pc)#cs, False)⌋ _) -ek→ (_ (C, M, Suc pc)#cs,None _)"
| JCFG_Getfield_Exc_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Getfield Fd Cl);
find_handler_for P NullPointer ((C, M, pc)#cs) = cs';
ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1) = Null)⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊(cs', True)⌋ _)"
| JCFG_Getfield_Exc_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Getfield Fd Cl);
find_handler_for P NullPointer ((C, M, pc)#cs) = (C', M', pc')#cs';
ek = ⇑(λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
loc)
) ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((C', M', pc')#cs', True)⌋ _) -ek→ (_ (C', M', pc')#cs',None _)"
| JCFG_Getfield_Exc_Exit:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Getfield Fd Cl);
find_handler_for P NullPointer ((C, M, pc)#cs) = [] ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊([], True)⌋ _) -⇑id→ (_Exit_)"
| JCFG_Putfield_Normal_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Putfield Fd Cl);
ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 2) ≠ Null)⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊((C, M, Suc pc)#cs, False)⌋ _)"
| JCFG_Putfield_Normal_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Putfield Fd Cl);
ek = ⇑(λs. exec_instr (Putfield Fd Cl) P s (length cs) (stkLength P C M pc)
arbitrary arbitrary) ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((C, M, Suc pc)#cs, False)⌋ _) -ek→ (_ (C, M, Suc pc)#cs,None _)"
| JCFG_Putfield_Exc_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Putfield Fd Cl);
find_handler_for P NullPointer ((C, M, pc)#cs) = cs';
ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 2) = Null)⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊(cs', True)⌋ _)"
| JCFG_Putfield_Exc_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Putfield Fd Cl);
find_handler_for P NullPointer ((C, M, pc)#cs) = (C', M', pc')#cs';
ek = ⇑(λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
loc)
) ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((C', M', pc')#cs', True)⌋ _) -ek→ (_ (C', M', pc')#cs',None _)"
| JCFG_Putfield_Exc_Exit:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Putfield Fd Cl);
find_handler_for P NullPointer ((C, M, pc)#cs) = [] ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊([], True)⌋ _) -⇑id→ (_Exit_)"
| JCFG_Checkcast_Normal_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Checkcast Cl);
ek = (λ(h,stk,loc). cast_ok (P⇘wf⇙) Cl h (stk(length cs, stkLength P C M pc - Suc 0)))⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, Suc pc)#cs,None _)"
| JCFG_Checkcast_Exc_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Checkcast Cl);
find_handler_for P ClassCast ((C, M, pc)#cs) = cs';
ek = (λ(h,stk,loc). ¬ cast_ok (P⇘wf⇙) Cl h (stk(length cs, stkLength P C M pc - Suc 0)))⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊(cs', True)⌋ _)"
| JCFG_Checkcast_Exc_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Checkcast Cl);
find_handler_for P ClassCast ((C, M, pc)#cs) = (C', M', pc')#cs';
ek = ⇑(λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt ClassCast)),
loc)
) ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((C', M', pc')#cs', True)⌋ _) -ek→ (_ (C', M', pc')#cs',None _)"
| JCFG_Checkcast_Exc_Exit:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Checkcast Cl);
find_handler_for P ClassCast ((C, M, pc)#cs) = [] ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊([], True)⌋ _) -⇑id→ (_Exit_)"
| JCFG_Invoke_Normal_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Invoke M2 n);
cd = length cs;
stk_length = stkLength P C M pc;
ek = (λ(h,stk,loc).
stk(cd, stk_length - Suc n) ≠ Null ∧
fst(method (P⇘wf⇙) (cname_of h (the_Addr(stk(cd, stk_length - Suc n)))) M2) = D
)⇩√ ⟧
⟹
prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊((D, M2, 0)#(C, M, pc)#cs, False)⌋ _)"
| JCFG_Invoke_Normal_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Invoke M2 n);
stk_length = stkLength P C M pc;
loc_length = locLength P D M2 0;
ek = ⇑(λs. exec_instr (Invoke M2 n) P s (length cs) stk_length arbitrary loc_length)
⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((D, M2, 0)#(C, M, pc)#cs, False)⌋ _) -ek→
(_ (D, M2, 0)#(C, M, pc)#cs,None _)"
| JCFG_Invoke_Exc_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Invoke m2 n);
find_handler_for P NullPointer ((C, M, pc)#cs) = cs';
ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - Suc n) = Null)⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊(cs', True)⌋ _)"
| JCFG_Invoke_Exc_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Invoke M2 n);
find_handler_for P NullPointer ((C, M, pc)#cs) = (C', M', pc')#cs';
ek = ⇑(λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
loc)
)
⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((C', M', pc')#cs', True)⌋ _) -ek→ (_ (C', M', pc')#cs',None _)"
| JCFG_Invoke_Exc_Exit:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (Invoke M2 n);
find_handler_for P NullPointer ((C, M, pc)#cs) = [] ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊([], True)⌋ _) -⇑id→ (_Exit_)"
| JCFG_Return_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = Return;
stk_length = stkLength P C M pc;
r_stk_length = stkLength P C' M' (Suc pc');
ek = ⇑(λs. exec_instr Return P s (Suc (length cs)) stk_length r_stk_length arbitrary) ⟧
⟹ prog ⊢ (_ (C, M, pc)#(C', M', pc')#cs,None _) -ek→ (_ (C', M', Suc pc')#cs,None _)"
| JCFG_Goto_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = Goto idx ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -⇑id→ (_ (C, M, nat (int pc + idx))#cs,None _)"
| JCFG_IfFalse_False:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (IfFalse b);
b ≠ 1;
ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1) = Bool False)⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, nat (int pc + b))#cs,None _)"
| JCFG_IfFalse_Next:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = (IfFalse b);
ek = (λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1) ≠ Bool False ∨ b = 1)⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, Suc pc)#cs,None _)"
| JCFG_Throw_Pred:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = Throw;
cd = length cs;
stk_length = stkLength P C M pc;
∃Exc. find_handler_for P Exc ((C, M, pc)#cs) = cs';
ek = (λ(h,stk,loc).
(stk(length cs, stkLength P C M pc - 1) = Null ∧
find_handler_for P NullPointer ((C, M, pc)#cs) = cs') ∨
(stk(length cs, stkLength P C M pc - 1) ≠ Null ∧
find_handler_for P (cname_of h (the_Addr(stk(cd, stk_length - 1)))) ((C, M, pc)#cs) = cs')
)⇩√ ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,None _) -ek→ (_ (C, M, pc)#cs,⌊(cs', True)⌋ _)"
| JCFG_Throw_Update:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = Throw;
ek = ⇑(λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) :=
if (stk(length cs, stkLength P C M pc - 1) = Null) then
Addr (addr_of_sys_xcpt NullPointer)
else (stk(length cs, stkLength P C M pc - 1))),
loc)
) ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊((C', M', pc')#cs', True)⌋ _) -ek→ (_ (C', M', pc')#cs',None _)"
| JCFG_Throw_Exit:
"⟦ prog = (P, C0, Main);
(instrs_of (P⇘wf⇙) C M) ! pc = Throw ⟧
⟹ prog ⊢ (_ (C, M, pc)#cs,⌊([],True)⌋ _) -⇑id→ (_Exit_)"
subsection ‹CFG properties›
lemma JVMCFG_Exit_no_sourcenode [dest]:
assumes edge:"prog ⊢ (_Exit_) -et→ n'"
shows "False"
proof -
{ fix n
have "⟦prog ⊢ n -et→ n'; n = (_Exit_)⟧ ⟹ False"
by (auto elim!: JVM_CFG.cases)
}
with edge show ?thesis by fastforce
qed
lemma JVMCFG_Entry_no_targetnode [dest]:
assumes edge:"prog ⊢ n -et→ (_Entry_)"
shows "False"
proof -
{ fix n' have "⟦prog ⊢ n -et→ n'; n' = (_Entry_)⟧ ⟹ False"
by (auto elim!: JVM_CFG.cases)
}
with edge show ?thesis by fastforce
qed
lemma JVMCFG_EntryD:
"⟦(P,C,M) ⊢ n -et→ n'; n = (_Entry_)⟧
⟹ (n' = (_Exit_) ∧ et = (λs. False)⇩√) ∨ (n' = (_ [(C,M,0)],None _) ∧ et = (λs. True)⇩√)"
by (erule JVM_CFG.cases) simp_all
declare split_def [simp add]
declare find_handler_for.simps [simp del]
lemma JVMCFG_edge_det:
"⟦prog ⊢ n -et→ n'; prog ⊢ n -et'→ n'⟧ ⟹ et = et'"
by (erule JVM_CFG.cases, (erule JVM_CFG.cases, fastforce+)+)
declare split_def [simp del]
declare find_handler_for.simps [simp add]
end
Theory JVMInterpretation
theory JVMInterpretation imports JVMCFG "../Basic/CFGExit" begin
section ‹Instatiation of the ‹CFG› locale›
abbreviation sourcenode :: "j_edge ⇒ j_node"
where "sourcenode e ≡ fst e"
abbreviation targetnode :: "j_edge ⇒ j_node"
where "targetnode e ≡ snd(snd e)"
abbreviation kind :: "j_edge ⇒ state edge_kind"
where "kind e ≡ fst(snd e)"
text ‹
The following predicates define the aforementioned well-formedness requirements
for nodes. Later, ‹valid_callstack› will be implied by Jinja's state conformance.
›
fun valid_callstack :: "jvmprog ⇒ callstack ⇒ bool"
where
"valid_callstack prog [] = True"
| "valid_callstack (P, C0, Main) [(C, M, pc)] ⟷
C = C0 ∧ M = Main ∧
(P⇘Φ⇙) C M ! pc ≠ None ∧
(∃T Ts mxs mxl is xt. (P⇘wf⇙) ⊢ C sees M:Ts→T=(mxs, mxl, is, xt) in C ∧ pc < length is)"
| "valid_callstack (P, C0, Main) ((C, M, pc)#(C', M', pc')#cs) ⟷
instrs_of (P⇘wf⇙) C' M' ! pc' =
Invoke M (locLength P C M 0 - Suc (fst(snd(snd(snd(snd(method (P⇘wf⇙) C M)))))) ) ∧
(P⇘Φ⇙) C M ! pc ≠ None ∧
(∃T Ts mxs mxl is xt. (P⇘wf⇙) ⊢ C sees M:Ts→T=(mxs, mxl, is, xt) in C ∧ pc < length is) ∧
valid_callstack (P, C0, Main) ((C', M', pc')#cs)"
fun valid_node :: "jvmprog ⇒ j_node ⇒ bool"
where
"valid_node prog (_Entry_) = True"
| "valid_node prog (_ cs,None _) ⟷ valid_callstack prog cs"
| "valid_node prog (_ cs,⌊(cs', xf)⌋ _) ⟷
valid_callstack prog cs ∧ valid_callstack prog cs' ∧
(∃Q. prog ⊢ (_ cs,None _) -(Q)⇩√→ (_ cs,⌊(cs', xf)⌋ _)) ∧
(∃f. prog ⊢ (_ cs,⌊(cs', xf)⌋ _) -⇑f→ (_ cs',None _))"
fun valid_edge :: "jvmprog ⇒ j_edge ⇒ bool"
where
"valid_edge prog a ⟷
(prog ⊢ (sourcenode a) -(kind a)→ (targetnode a))
∧ (valid_node prog (sourcenode a))
∧ (valid_node prog (targetnode a))"
interpretation JVM_CFG_Interpret:
CFG "sourcenode" "targetnode" "kind" "valid_edge prog" "Entry"
for prog
proof (unfold_locales)
fix a
assume ve: "valid_edge prog a"
and trg: "targetnode a = (_Entry_)"
obtain n et n'
where "a = (n,et,n')"
by (cases a) fastforce
with ve trg
have "prog ⊢ n -et→ (_Entry_)" by simp
thus False by fastforce
next
fix a a'
assume valid: "valid_edge prog a"
and valid': "valid_edge prog a'"
and sourceeq: "sourcenode a = sourcenode a'"
and targeteq: "targetnode a = targetnode a'"
obtain n1 et n2
where a:"a = (n1, et, n2)"
by (cases a) fastforce
obtain n1' et' n2'
where a':"a' = (n1', et', n2')"
by (cases a') fastforce
from a valid a' valid' sourceeq targeteq
have "et = et'"
by (fastforce elim: JVMCFG_edge_det)
with a a' sourceeq targeteq
show "a = a'"
by simp
qed
interpretation JVM_CFGExit_Interpret:
CFGExit "sourcenode" "targetnode" "kind" "valid_edge prog" "Entry" "(_Exit_)"
for prog
proof(unfold_locales)
fix a
assume ve: "valid_edge prog a"
and src: "sourcenode a = (_Exit_)"
obtain n et n'
where "a = (n,et,n')"
by (cases a) fastforce
with ve src
have "prog ⊢ (_Exit_) -et→ n'" by simp
thus False by fastforce
next
have "prog ⊢ (_Entry_) -(λs. False)⇩√→ (_Exit_)"
by (rule JCFG_EntryExit)
thus "∃a. valid_edge prog a ∧ sourcenode a = (_Entry_) ∧
targetnode a = (_Exit_) ∧ kind a = (λs. False)⇩√"
by fastforce
qed
end
Theory JVMPostdomination
chapter ‹Standard and Weak Control Dependence›
section ‹A type for well-formed programs›
theory JVMPostdomination imports JVMInterpretation "../Basic/Postdomination" begin
text ‹
For instantiating ‹Postdomination› every node in the CFG of a program must be
reachable from the ‹(_Entry_)› node and there must be a path to the
‹(_Exit_)› node from each node.
Therefore, we restrict the set of allowed programs to those, where the CFG fulfills
these requirements. This is done by defining a new type for well-formed programs.
The universe of every type in Isabelle must be non-empty. That's why we first
define an example program ‹EP› and its typing ‹Phi_EP›, which
is a member of the carrier set of the later defined type.
Restricting the set of allowed programs in this way is reasonable, as Jinja's compiler
only produces byte code programs, that are members of this type (A proof for this is
current work).
›
definition EP :: jvm_prog
where "EP = (''C'', Object, [], [(''M'', [], Void, 1::nat, 0::nat, [Push Unit, Return], [])]) #
SystemClasses"
definition Phi_EP :: ty⇩P
where "Phi_EP C M = (if C = ''C'' ∧ M = ''M'' then [⌊([],[OK (Class ''C'')])⌋,⌊([Void],[OK (Class ''C'')])⌋] else [])"
text ‹
Now we show, that ‹EP› is indeed a well-formed program in the sense of Jinja's
byte code verifier
›
lemma distinct_classes'':
"''C'' ≠ Object"
"''C'' ≠ NullPointer"
"''C'' ≠ OutOfMemory"
"''C'' ≠ ClassCast"
by (simp_all add: Object_def NullPointer_def OutOfMemory_def ClassCast_def)
lemmas distinct_classes =
distinct_classes distinct_classes'' distinct_classes'' [symmetric]
declare distinct_classes [simp add]
lemma i_max_2D: "i < Suc (Suc 0) ⟹ i = 0 ∨ i = 1"
by auto
lemma EP_wf: "wf_jvm_prog⇘Phi_EP⇙ EP"
unfolding wf_jvm_prog_phi_def wf_prog_def
proof
show "wf_syscls EP"
by (simp add: EP_def wf_syscls_def SystemClasses_def sys_xcpts_def
ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def)
next
have distinct_EP: "distinct_fst EP"
by (auto simp:
EP_def SystemClasses_def ObjectC_def NullPointerC_def OutOfMemoryC_def ClassCastC_def)
have classes_wf:
"∀c∈set EP.
wf_cdecl
(λP C (M, Ts, T⇩r, mxs, mxl⇩0, is, xt). wt_method P C Ts T⇩r mxs mxl⇩0 is xt (Phi_EP C M))
EP c"
proof
fix C
assume C_in_EP: "C ∈ set EP"
show "wf_cdecl
(λP C (M, Ts, T⇩r, mxs, mxl⇩0, is, xt). wt_method P C Ts T⇩r mxs mxl⇩0 is xt (Phi_EP C M))
EP C"
proof (cases "C ∈ set SystemClasses")
case True
thus ?thesis
by (auto simp: wf_cdecl_def SystemClasses_def ObjectC_def NullPointerC_def
OutOfMemoryC_def ClassCastC_def EP_def class_def)
next
case False
with C_in_EP
have [simp]: "C = (''C'', the (class EP ''C''))"
by (auto simp: EP_def SystemClasses_def class_def)
show ?thesis
apply (auto dest!: i_max_2D
simp: wf_cdecl_def class_def EP_def wf_mdecl_def wt_method_def Phi_EP_def
wt_start_def check_types_def states_def JVM_SemiType.sl_def
stk_esl_def upto_esl_def loc_sl_def SemiType.esl_def
SemiType.sup_def Err.sl_def Err.le_def err_def Listn.sl_def
Err.esl_def Opt.esl_def Product.esl_def relevant_entries_def)
apply (fastforce simp: SystemClasses_def ObjectC_def)
apply (clarsimp simp: Method_def)
apply (cases rule: Methods.cases,
(fastforce simp: class_def SystemClasses_def ObjectC_def)+)
apply (clarsimp simp: Method_def)
by (cases rule: Methods.cases,
(fastforce simp: class_def SystemClasses_def ObjectC_def)+)
qed
qed
with distinct_EP
show "(∀c∈set EP.
wf_cdecl
(λP C (M, Ts, T⇩r, mxs, mxl⇩0, is, xt). wt_method P C Ts T⇩r mxs mxl⇩0 is xt (Phi_EP C M))
EP c) ∧
distinct_fst EP"
by simp
qed
lemma [simp]: "Abs_wf_jvmprog (EP, Phi_EP)⇘wf⇙ = EP"
proof (cases "(EP, Phi_EP) ∈ wf_jvmprog")
case True
thus ?thesis
by (simp add: Abs_wf_jvmprog_inverse)
next
case False
with EP_wf
show ?thesis
by (simp add: wf_jvmprog_def)
qed
lemma [simp]: "Abs_wf_jvmprog (EP, Phi_EP)⇘Φ⇙ = Phi_EP"
proof (cases "(EP, Phi_EP) ∈ wf_jvmprog")
case True
thus ?thesis
by (simp add: Abs_wf_jvmprog_inverse)
next
case False
with EP_wf
show ?thesis
by (simp add: wf_jvmprog_def)
qed
lemma method_in_EP_is_M:
"EP ⊢ C sees M: Ts→T = (mxs, mxl, is, xt) in D
⟹ C = ''C'' ∧
M = ''M'' ∧
Ts = [] ∧
T = Void ∧
mxs = 1 ∧
mxl = 0 ∧
is = [Push Unit, Return] ∧
xt = [] ∧
D = ''C''"
apply (clarsimp simp: Method_def EP_def)
apply (erule Methods.cases, clarsimp simp: class_def SystemClasses_def ObjectC_def)
apply (clarsimp simp: class_def)
apply (erule Methods.cases)
by (fastforce simp: class_def SystemClasses_def ObjectC_def NullPointerC_def
OutOfMemoryC_def ClassCastC_def if_split_eq1)+
lemma [simp]:
"∃T Ts mxs mxl is. (∃xt. EP ⊢ ''C'' sees ''M'': Ts→T = (mxs, mxl, is, xt) in ''C'') ∧ is ≠ []"
using EP_wf
by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)
lemma [simp]:
"∃T Ts mxs mxl is. (∃xt. EP ⊢ ''C'' sees ''M'': Ts→T = (mxs, mxl, is, xt) in ''C'') ∧
Suc 0 < length is"
using EP_wf
by (fastforce dest: mdecl_visible simp: wf_jvm_prog_phi_def EP_def)
lemma C_sees_M_in_EP [simp]:
"EP ⊢ ''C'' sees ''M'': []→Void = (1, 0, [Push Unit, Return], []) in ''C''"
apply (auto simp: Method_def EP_def)
apply (rule_tac x="Map.empty(''M'' ↦ (([], Void, 1, 0, [Push Unit, Return], []),''C''))" in exI)
apply auto
apply (rule Methods.intros(2))
apply (fastforce simp: class_def)
apply clarsimp
apply (rule Methods.intros(1))
apply (fastforce simp: class_def SystemClasses_def ObjectC_def)
apply fastforce
by fastforce
lemma instrs_of_EP_C_M [simp]:
"instrs_of EP ''C'' ''M'' = [Push Unit, Return]"
using C_sees_M_in_EP
apply (simp add: method_def)
apply (rule theI2)
apply fastforce
apply (clarsimp dest!: method_in_EP_is_M)
by (clarsimp dest!: method_in_EP_is_M)
lemma valid_node_in_EP_D:
"valid_node (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') n
⟹ n ∈ {(_Entry_), (_ [(''C'', ''M'', 0)],None _), (_ [(''C'', ''M'', 1)],None _), (_Exit_)}"
proof -
assume vn: "valid_node (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'') n"
show ?thesis
proof (cases n)
case Entry
thus ?thesis
by simp
next
case [simp]: (Node cs opt)
show ?thesis
proof (cases opt)
case [simp]: None
from vn
show ?thesis
apply (cases cs)
apply simp
apply (case_tac list)
apply clarsimp
apply (drule method_in_EP_is_M)
apply clarsimp
apply clarsimp
apply (drule method_in_EP_is_M)
apply clarsimp
apply (case_tac lista)
apply clarsimp
apply (drule method_in_EP_is_M)
apply clarsimp
apply (case_tac ba, clarsimp, clarsimp)
apply clarsimp
apply (drule method_in_EP_is_M)
apply clarsimp
by (case_tac ba, clarsimp, clarsimp)
next
case [simp]: (Some f)
obtain cs'' xf where [simp]: "f = (cs'', xf)"
by (cases f, fastforce)
from vn
show ?thesis
apply (cases cs)
apply clarsimp
apply (erule JVM_CFG.cases, clarsimp+)
apply (case_tac list)
apply clarsimp
apply (frule method_in_EP_is_M)
apply (case_tac b)
apply (erule JVM_CFG.cases, clarsimp+)
apply (erule JVM_CFG.cases, clarsimp+)
apply (frule method_in_EP_is_M)
apply (case_tac b)
apply (erule JVM_CFG.cases, clarsimp+)
by (erule JVM_CFG.cases, clarsimp+)
qed
qed
qed
lemma EP_C_M_0_valid [simp]:
"JVM_CFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')
(_ [(''C'', ''M'', 0)],None _)"
proof -
have "valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')
((_Entry_), (λs. True)⇩√, (_ [(''C'', ''M'', 0)],None _))"
apply (auto simp: Phi_EP_def)
by rule auto
thus ?thesis
by (fastforce simp: JVM_CFG_Interpret.valid_node_def)
qed
lemma EP_C_M_Suc_0_valid [simp]:
"JVM_CFG_Interpret.valid_node (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')
(_ [(''C'', ''M'', Suc 0)],None _)"
proof -
have "valid_edge (Abs_wf_jvmprog (EP, Phi_EP), ''C'', ''M'')
((_ [(''C'', ''M'', Suc 0)],None _), ⇑id, (_Exit_))"
apply (auto simp: Phi_EP_def)
by rule auto
thus ?thesis
by (fastforce simp: JVM_CFG_Interpret.valid_node_def)
qed
definition
"cfg_wf_prog =
{P. (∀n. valid_node P n ⟶
(∃as. JVM_CFG_Interpret.path P (_Entry_) as n) ∧
(∃as. JVM_CFG_Interpret.path P n as (_Exit_)))}"
typedef cfg_wf_prog = cfg_wf_prog
unfolding cfg_wf_prog_def
proof
let ?prog = "((Abs_wf_jvmprog (EP, Phi_EP)), ''C'', ''M'')"
let ?edge0 = "((_Entry_), (λs. False)⇩√, (_Exit_))"
let ?edge1 = "((_Entry_), (λs. True)⇩√, (_ [(''C'', ''M'', 0)],None _))"
let ?edge2 = "((_ [(''C'', ''M'', 0)],None _),
⇑(λ(h, stk, loc). (h, stk((0, 0) := Unit), loc)),
(_ [(''C'', ''M'', 1)],None _))"
let ?edge3 = "((_ [(''C'', ''M'', 1)],None _), ⇑id, (_Exit_))"
show "?prog ∈ {P. ∀n. valid_node P n ⟶
(∃as. CFG.path sourcenode targetnode (valid_edge P) (_Entry_) as n) ∧
(∃as. CFG.path sourcenode targetnode (valid_edge P) n as (_Exit_))}"
proof (auto dest!: valid_node_in_EP_D)
have "JVM_CFG_Interpret.path ?prog (_Entry_) [] (_Entry_)"
by (simp add: JVM_CFG_Interpret.path.empty_path)
thus "∃as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_Entry_)"
by fastforce
next
have "JVM_CFG_Interpret.path ?prog (_Entry_) [?edge0] (_Exit_)"
by rule (auto intro: JCFG_EntryExit JVM_CFG_Interpret.path.empty_path)
thus "∃as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_Exit_)"
by fastforce
next
have "JVM_CFG_Interpret.path ?prog (_Entry_) [?edge1] (_ [(''C'', ''M'', 0)],None _)"
by rule (auto intro: JCFG_EntryStart simp: JVM_CFG_Interpret.path.empty_path Phi_EP_def)
thus "∃as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_ [(''C'', ''M'', 0)],None _)"
by fastforce
next
have "JVM_CFG_Interpret.path ?prog (_ [(''C'', ''M'', 0)],None _) [?edge2, ?edge3] (_Exit_)"
apply rule
apply rule
apply (auto simp: JVM_CFG_Interpret.path.empty_path Phi_EP_def)
apply (rule JCFG_ReturnExit, auto)
by (rule JCFG_Straight_NoExc, auto simp: Phi_EP_def)
thus "∃as. JVM_CFG_Interpret.path ?prog (_ [(''C'', ''M'', 0)],None _) as (_Exit_)"
by fastforce
next
have "JVM_CFG_Interpret.path ?prog (_Entry_) [?edge1, ?edge2] (_ [(''C'', ''M'', 1)],None _)"
apply rule
apply rule
apply (auto simp: JVM_CFG_Interpret.path.empty_path Phi_EP_def)
apply (rule JCFG_Straight_NoExc, auto simp: Phi_EP_def)
by (rule JCFG_EntryStart, auto)
thus "∃as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_ [(''C'', ''M'', Suc 0)],None _)"
by fastforce
next
have "JVM_CFG_Interpret.path ?prog (_ [(''C'', ''M'', Suc 0)],None _) [?edge3] (_Exit_)"
apply rule
apply (auto simp: JVM_CFG_Interpret.path.empty_path Phi_EP_def)
by (rule JCFG_ReturnExit, auto)
thus "∃as. JVM_CFG_Interpret.path ?prog (_ [(''C'', ''M'', Suc 0)],None _) as (_Exit_)"
by fastforce
next
have "JVM_CFG_Interpret.path ?prog (_Entry_) [?edge0] (_Exit_)"
by rule (auto intro: JCFG_EntryExit JVM_CFG_Interpret.path.empty_path)
thus "∃as. JVM_CFG_Interpret.path ?prog (_Entry_) as (_Exit_)"
by fastforce
next
have "JVM_CFG_Interpret.path ?prog (_Exit_) [] (_Exit_)"
by (simp add: JVM_CFG_Interpret.path.empty_path)
thus "∃as. JVM_CFG_Interpret.path ?prog (_Exit_) as (_Exit_)"
by fastforce
qed
qed
abbreviation lift_to_cfg_wf_prog :: "(jvmprog ⇒ 'a) ⇒ (cfg_wf_prog ⇒ 'a)"
("_⇘CFG⇙")
where "f⇘CFG⇙ ≡ (λP. f (Rep_cfg_wf_prog P))"
section ‹Interpretation of the ‹Postdomination› locale›
interpretation JVM_CFG_Postdomination:
Postdomination "sourcenode" "targetnode" "kind" "valid_edge⇘CFG⇙ prog" "Entry" "(_Exit_)"
for prog
proof(unfold_locales)
fix n
assume vn: "CFG.valid_node sourcenode targetnode (valid_edge⇘CFG⇙ prog) n"
have prog_is_cfg_wf_prog: "Rep_cfg_wf_prog prog ∈ cfg_wf_prog"
by (rule Rep_cfg_wf_prog)
obtain P C0 Main where [simp]: "Rep_cfg_wf_prog prog = (P,C0,Main)"
by (cases "Rep_cfg_wf_prog prog", fastforce)
from prog_is_cfg_wf_prog have "(P, C0, Main) ∈ cfg_wf_prog"
by simp
hence "valid_node (P, C0, Main) n ⟶
(∃as. CFG.path sourcenode targetnode (valid_edge (P, C0, Main)) (_Entry_) as n)"
by (fastforce simp: cfg_wf_prog_def)
moreover from vn have "valid_node (P, C0, Main) n"
by (auto simp: JVM_CFG_Interpret.valid_node_def)
ultimately
show "∃as. CFG.path sourcenode targetnode (valid_edge⇘CFG⇙ prog) (_Entry_) as n"
by simp
next
fix n
assume vn: "CFG.valid_node sourcenode targetnode (valid_edge⇘CFG⇙ prog) n"
have prog_is_cfg_wf_prog: "Rep_cfg_wf_prog prog ∈ cfg_wf_prog"
by (rule Rep_cfg_wf_prog)
obtain P C0 Main where [simp]: "Rep_cfg_wf_prog prog = (P,C0,Main)"
by (cases "Rep_cfg_wf_prog prog", fastforce)
from prog_is_cfg_wf_prog have "(P, C0, Main) ∈ cfg_wf_prog"
by simp
hence "valid_node (P, C0, Main) n ⟶
(∃as. CFG.path sourcenode targetnode (valid_edge (P, C0, Main)) n as (_Exit_))"
by (fastforce simp: cfg_wf_prog_def)
moreover from vn have "valid_node (P, C0, Main) n"
by (auto simp: JVM_CFG_Interpret.valid_node_def)
ultimately
show "∃as. CFG.path sourcenode targetnode (valid_edge⇘CFG⇙ prog) n as (_Exit_)"
by simp
qed
section ‹Interpretation of the ‹StrongPostdomination› locale›
subsection ‹Some helpfull lemmas›
lemma find_handler_for_tl_eq:
"find_handler_for P Exc cs = (C,M,pcx)#cs' ⟹ ∃cs'' pc. cs = cs'' @ [(C,M,pc)] @ cs'"
by (induct cs, auto)
lemma valid_callstack_tl:
"valid_callstack prog ((C,M,pc)#cs) ⟹ valid_callstack prog cs"
by (cases prog, cases cs, auto)
lemma find_handler_Throw_Invoke_pc_in_range:
"⟦cs = (C',M',pc')#cs'; valid_callstack (P,C0,Main) cs;
instrs_of (P⇘wf⇙) C' M' ! pc' = Throw ∨ (∃M'' n''. instrs_of (P⇘wf⇙) C' M' ! pc' = Invoke M'' n'');
find_handler_for P Exc cs = (C,M,pc)#cs'' ⟧
⟹ pc < length (instrs_of (P⇘wf⇙) C M)"
proof (induct cs arbitrary: C' M' pc' cs')
case Nil
thus ?case by simp
next
case (Cons a cs)
hence [simp]: "a = (C',M',pc')" and [simp]: "cs = cs'" by simp_all
note IH = ‹⋀C' M' pc' cs'.
⟦cs = (C', M', pc') # cs'; valid_callstack (P, C0, Main) cs;
instrs_of P⇘wf⇙ C' M' ! pc' = Throw ∨
(∃M'' n''. instrs_of P⇘wf⇙ C' M' ! pc' = Invoke M'' n'');
find_handler_for P Exc cs = (C, M, pc) # cs''⟧
⟹ pc < length (instrs_of P⇘wf⇙ C M)›
note throw = ‹instrs_of P⇘wf⇙ C' M' ! pc' = Throw ∨ (∃M'' n''. instrs_of P⇘wf⇙ C' M' ! pc' = Invoke M'' n'')›
note fhf = ‹find_handler_for P Exc (a # cs) = (C, M, pc) # cs''›
note v_cs_a_cs = ‹valid_callstack (P, C0, Main) (a # cs)›
show ?case
proof (cases "match_ex_table (P⇘wf⇙) Exc pc' (ex_table_of (P⇘wf⇙) C' M')")
case None
with fhf have fhf_tl: "find_handler_for P Exc cs = (C,M,pc)#cs''"
by simp
from v_cs_a_cs have "valid_callstack (P, C0, Main) cs"
by (auto dest: valid_callstack_tl)
from v_cs_a_cs
have "cs ≠ [] ⟶ (let (C,M,pc) = hd cs in ∃n. instrs_of (P⇘wf⇙) C M ! pc = Invoke M' n)"
by (cases cs', auto)
with IH None fhf_tl ‹valid_callstack (P, C0, Main) cs›
show ?thesis
by (cases cs) fastforce+
next
case (Some xte)
with fhf have [simp]: "C' = C" and [simp]: "M' = M" by simp_all
from v_cs_a_cs fhf Some
obtain Ts T mxs mxl "is" xt where wt_class:
"(P⇘wf⇙) ⊢ C sees M: Ts→T = (mxs, mxl, is, xt) in C ∧
pc' < length is ∧ (P⇘Φ⇙) C M ! pc' ≠ None"
by (cases cs) fastforce+
with wf_jvmprog_is_wf [of P]
have wt_instr:"(P⇘wf⇙),T,mxs,length is,xt ⊢ is ! pc',pc' :: (P⇘Φ⇙) C M"
by (fastforce dest!: wt_jvm_prog_impl_wt_instr)
from Some fhf obtain f t D d where "(f,t,D,pc,d)∈ set (ex_table_of (P⇘wf⇙) C M) ∧
matches_ex_entry (P⇘wf⇙) Exc pc' (f,t,D,pc,d)"
by (cases xte, fastforce dest: match_ex_table_SomeD)
with wt_instr throw wt_class
show ?thesis
by (fastforce simp: relevant_entries_def is_relevant_entry_def matches_ex_entry_def)
qed
qed
subsection ‹Every node has only finitely many successors›
lemma successor_set_finite:
"JVM_CFG_Interpret.valid_node prog n
⟹ finite {n'. ∃a'. valid_edge prog a' ∧ sourcenode a' = n ∧
targetnode a' = n'}"
proof -
assume valid_node: "JVM_CFG_Interpret.valid_node prog n"
obtain P C0 Main where [simp]: "prog = (P, C0, Main)"
by (cases prog, fastforce)
note P_wf = wf_jvmprog_is_wf [of P]
show ?thesis
proof (cases n)
case Entry
thus ?thesis
by (rule_tac B="{(_Exit_), (_ [(C0, Main, 0)],None _)}" in finite_subset,
auto dest: JVMCFG_EntryD)
next
case [simp]: (Node cs x)
show ?thesis
proof (cases cs)
case Nil
thus ?thesis
by (rule_tac B="{}" in finite_subset,
auto elim: JVM_CFG.cases)
next
case [simp]: (Cons a cs')
obtain C M pc where [simp]: "a = (C,M,pc)" by (cases a, fastforce)
have finite_classes: "finite {C. is_class (P⇘wf⇙) C}"
by (rule finite_is_class)
from valid_node have "is_class (P⇘wf⇙) C"
apply (auto simp: JVM_CFG_Interpret.valid_node_def)
apply (cases x, auto)
apply (cases cs', auto dest!: sees_method_is_class)
apply (cases cs', auto dest!: sees_method_is_class)
apply (cases cs', auto dest!: sees_method_is_class)
apply (cases x, auto dest!: sees_method_is_class)
by (cases x, auto dest!: sees_method_is_class)
show ?thesis
proof (cases "instrs_of (P⇘wf⇙) C M ! pc")
case (Load nat)
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,Suc pc)#cs',x _)}" in finite_subset)
by (auto elim: JVM_CFG.cases)
next
case (Store nat)
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,Suc pc)#cs',x _)}" in finite_subset)
by (auto elim: JVM_CFG.cases)
next
case (Push val)
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,Suc pc)#cs',x _)}" in finite_subset)
by (auto elim: JVM_CFG.cases)
next
case (New C')
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,pc)#cs',⌊((C,M,Suc pc)#cs',False)⌋ _),
(_ (C,M,pc)#cs',⌊(find_handler_for P OutOfMemory ((C,M,pc)#cs'),True)⌋ _),
(_ fst(the(x)),None _)}" in finite_subset)
apply (rule subsetI)
apply (clarsimp simp del: find_handler_for.simps)
by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
next
case (Getfield Fd C')
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,pc)#cs',⌊((C,M,Suc pc)#cs',False)⌋ _),
(_ (C,M,pc)#cs',⌊(find_handler_for P NullPointer ((C,M,pc)#cs'),True)⌋ _),
(_ fst(the(x)),None _)}" in finite_subset)
apply (rule subsetI)
apply (clarsimp simp del: find_handler_for.simps)
by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
next
case (Putfield Fd C')
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,pc)#cs',⌊((C,M,Suc pc)#cs',False)⌋ _),
(_ (C,M,pc)#cs',⌊(find_handler_for P NullPointer ((C,M,pc)#cs'),True)⌋ _),
(_ fst(the(x)),None _)}" in finite_subset)
apply (rule subsetI)
apply (clarsimp simp del: find_handler_for.simps)
by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
next
case (Checkcast C')
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _),
(_ (C,M,pc)#cs',⌊(find_handler_for P ClassCast ((C,M,pc)#cs'),True)⌋ _),
(_ fst(the(x)),None _)}" in finite_subset)
apply (rule subsetI)
apply (clarsimp simp del: find_handler_for.simps)
by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
next
case (Invoke M' n')
with finite_classes valid_node
show ?thesis
apply auto
apply (rule_tac B="
{n'. (∃D. is_class (P⇘wf⇙) D ∧ n' = (_ (C,M,pc)#cs',⌊((D,M',0)#(C,M,pc)#cs',False)⌋ _))}
∪ {(_ (C,M,pc)#cs',⌊(find_handler_for P NullPointer ((C,M,pc)#cs'),True)⌋ _),
(_ fst(the(x)),None _)}"
in finite_subset)
apply (rule subsetI)
apply (clarsimp simp del: find_handler_for.simps)
apply (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
apply (clarsimp simp del: find_handler_for.simps)
apply (drule sees_method_is_class)
by (clarsimp simp del: find_handler_for.simps)
next
case Return
with valid_node
show ?thesis
apply auto
apply (rule_tac B="
{(_ (fst(hd(cs')),fst(snd(hd(cs'))),Suc(snd(snd(hd(cs')))))#(tl cs'),None _),
(_Exit_)}" in finite_subset)
apply (rule subsetI)
apply (clarsimp simp del: find_handler_for.simps)
by (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
next
case Pop
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _)}" in finite_subset)
by (auto elim: JVM_CFG.cases)
next
case IAdd
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _)}" in finite_subset)
by (auto elim: JVM_CFG.cases)
next
case (Goto i)
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,nat (int pc + i))#cs',None _)}" in finite_subset)
by (auto elim: JVM_CFG.cases)
next
case CmpEq
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _)}" in finite_subset)
by (auto elim: JVM_CFG.cases)
next
case (IfFalse i)
with valid_node
show ?thesis
apply auto
apply (rule_tac B="{(_ (C,M,Suc pc)#cs',None _),
(_ (C,M,nat (int pc + i))#cs',None _)}" in finite_subset)
by (auto elim: JVM_CFG.cases)
next
case Throw
have "finite {(l,pc'). l < Suc (length cs') ∧
pc' < (∑i≤(length cs'). (length (instrs_of (P⇘wf⇙) (fst (((C, M, pc) # cs') ! i))
(fst (snd (((C, M, pc) # cs') ! i))))))}"
(is "finite ?f1")
by (auto intro: finite_cartesian_product bounded_nat_set_is_finite)
hence f_1: "finite {(l,pc'). l < length ((C, M, pc) # cs') ∧
pc' < length (instrs_of (P⇘wf⇙) (fst(((C,M,pc)#cs')!l)) (fst(snd(((C,M,pc)#cs')!l))))}"
apply (rule_tac B="?f1" in finite_subset)
apply clarsimp
apply (rule less_le_trans)
defer
apply (rule_tac A="{a}" in sum_mono2)
by simp_all
from valid_node Throw
show ?thesis
apply auto
apply (rule_tac B="
{n'. ∃Cx Mx pc' h cs'' pcx. (C,M,pc)#cs' = cs''@[(Cx,Mx,pcx)]@h ∧
pc' < length (instrs_of (P⇘wf⇙) Cx Mx) ∧
n' = (_ (C,M,pc)#cs',⌊((Cx,Mx,pc')#h,True)⌋ _)}
∪ {(_ fst(the(x)),None _), (_Exit_), (_ (C,M,pc)#cs',⌊([],True)⌋ _)}"
in finite_subset)
apply (rule subsetI)
apply clarsimp
apply (erule JVM_CFG.cases, simp_all del: find_handler_for.simps)
apply (clarsimp simp del: find_handler_for.simps)
apply (case_tac "find_handler_for P Exc ((C,M,pc)#cs')", simp)
apply (clarsimp simp del: find_handler_for.simps)
apply (erule impE)
apply (case_tac "list", fastforce, fastforce)
apply (frule find_handler_for_tl_eq)
apply (clarsimp simp del: find_handler_for.simps)
apply (erule_tac x="list" in allE)
apply (clarsimp simp del: find_handler_for.simps)
apply (subgoal_tac
"finite (
(λ(Cx,Mx,pc',h,cs'',pcx). (_ (C, M, pc) # cs',⌊((Cx, Mx, pc') # h, True)⌋ _)) `
{(Cx,Mx,pc',h,cs'',pcx). (C, M, pc) # cs' = cs'' @ (Cx, Mx, pcx) # h ∧
pc' < length (instrs_of P⇘wf⇙ Cx Mx)})")
apply (case_tac "((λ(Cx, Mx, pc', h, cs'', pcx).
(_ (C, M, pc) # cs',⌊((Cx, Mx, pc') # h, True)⌋ _)) `
{(Cx, Mx, pc', h, cs'', pcx).
(C, M, pc) # cs' = cs'' @ (Cx, Mx, pcx) # h ∧
pc' < length (instrs_of (P⇘wf⇙) Cx Mx)}) =
{n'. ∃Cx Mx pc' h.
(∃cs'' pcx. (C, M, pc) # cs' = cs'' @ (Cx, Mx, pcx) # h) ∧
pc' < length (instrs_of (P⇘wf⇙) Cx Mx) ∧
n' = (_ (C, M, pc) # cs',⌊((Cx, Mx, pc') # h, True)⌋ _)}")
apply clarsimp
apply (erule notE)
apply (rule equalityI)
apply clarsimp
apply clarsimp
apply (rule_tac x="(Cx,Mx,pc',h,cs'',pcx)" in image_eqI)
apply clarsimp
apply clarsimp
apply (rule finite_imageI)
apply (subgoal_tac "finite (
(λ(l, pc'). (fst(((C, M, pc)#cs') ! l),
fst(snd(((C, M, pc)#cs') ! l)),
pc',
drop l cs',
take l ((C, M, pc)#cs'),
snd(snd(((C, M, pc)#cs') ! l))
)
) ` {(l, pc'). l < length ((C,M,pc)#cs') ∧
pc' < length (instrs_of (P⇘wf⇙) (fst(((C, M, pc)#cs') ! l))
(fst(snd(((C, M, pc)#cs') ! l))))})")
apply (case_tac "((λ(l, pc').
(fst (((C, M, pc) # cs') ! l),
fst (snd (((C, M, pc) # cs') ! l)),
pc',
drop l cs',
take l ((C, M, pc) # cs'),
snd (snd (((C, M, pc) # cs') ! l))
)) ` {(l, pc'). l < length ((C,M,pc)#cs') ∧
pc' < length (instrs_of (P⇘wf⇙) (fst (((C, M, pc) # cs') ! l))
(fst (snd (((C, M, pc) # cs') ! l))))})
= {(Cx, Mx, pc', h, cs'', pcx).
(C, M, pc) # cs' = cs'' @ (Cx, Mx, pcx) # h ∧
pc' < length (instrs_of (P⇘wf⇙) Cx Mx)}")
apply clarsimp
apply (erule notE)
apply (rule equalityI)
apply clarsimp
apply (rule id_take_nth_drop [of _ "(C,M,pc)#cs'", simplified])
apply simp
apply clarsimp
apply (rule_tac x="(length ad,ab)" in image_eqI)
apply clarsimp
apply (case_tac ad, clarsimp, clarsimp)
apply clarsimp
apply (case_tac ad, clarsimp, clarsimp)
apply (rule finite_imageI)
by (rule f_1)
qed
qed
qed
qed
subsection ‹Interpretation of the locale›
interpretation JVM_CFG_StrongPostdomination:
StrongPostdomination "sourcenode" "targetnode" "kind" "valid_edge⇘CFG⇙ prog" "Entry" "(_Exit_)"
for prog
proof(unfold_locales)
fix n
assume vn: "CFG.valid_node sourcenode targetnode (valid_edge⇘CFG⇙ prog) n"
thus "finite {n'. ∃a'. valid_edge⇘CFG⇙ prog a' ∧ sourcenode a' = n ∧ targetnode a' = n'}"
by (rule successor_set_finite)
qed
end
Theory JVMCFG_wf
theory JVMCFG_wf imports JVMInterpretation "../Basic/CFGExit_wf" begin
section ‹Instantiation of the ‹CFG_wf› locale›
subsection ‹Variables and Values›
datatype jinja_var = HeapVar "addr" | Stk "nat" "nat" | Loc "nat" "nat"
datatype jinja_val = Object "obj option" | Primitive "val"
fun state_val :: "state ⇒ jinja_var ⇒ jinja_val"
where
"state_val (h, stk, loc) (HeapVar a) = Object (h a)"
| "state_val (h, stk, loc) (Stk cd idx) = Primitive (stk (cd, idx))"
| "state_val (h, stk, loc) (Loc cd idx) = Primitive (loc (cd, idx))"
subsection ‹The ‹Def› and ‹Use› sets›
inductive_set Def :: "wf_jvmprog ⇒ j_node ⇒ jinja_var set"
for P :: "wf_jvmprog"
and n :: "j_node"
where
Def_Load:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Load idx;
cd = length cs;
i = stkLength P C M pc⟧
⟹ Stk cd i ∈ Def P n"
| Def_Store:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Store idx;
cd = length cs ⟧
⟹ Loc cd idx ∈ Def P n"
| Def_Push:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Push v;
cd = length cs;
i = stkLength P C M pc ⟧
⟹ Stk cd i ∈ Def P n"
| Def_New_Normal_Stk:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',False)⌋ _);
instrs_of (P⇘wf⇙) C M ! pc = New Cl;
cd = length cs;
i = stkLength P C M pc ⟧
⟹ Stk cd i ∈ Def P n"
| Def_New_Normal_Heap:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',False)⌋ _);
instrs_of (P⇘wf⇙) C M ! pc = New Cl ⟧
⟹ HeapVar a ∈ Def P n"
| Def_Exc_Stk:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',True)⌋ _);
cs' ≠ [];
cd = length cs' - 1;
(C',M',pc') = hd cs';
i = stkLength P C' M' pc' - 1⟧
⟹ Stk cd i ∈ Def P n"
| Def_Getfield_Stk:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',False)⌋ _);
instrs_of (P⇘wf⇙) C M ! pc = Getfield Fd Cl;
cd = length cs;
i = stkLength P C M pc - 1 ⟧
⟹ Stk cd i ∈ Def P n"
| Def_Putfield_Heap:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',False)⌋ _);
instrs_of (P⇘wf⇙) C M ! pc = Putfield Fd Cl ⟧
⟹ HeapVar a ∈ Def P n"
| Def_Invoke_Loc:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',False)⌋ _);
instrs_of (P⇘wf⇙) C M ! pc = Invoke M' n';
cs' ≠ [];
hd cs' = (C',M',0);
i < locLength P C' M' 0;
cd = Suc (length cs) ⟧
⟹ Loc cd i ∈ Def P n"
| Def_Return_Stk:
"⟦ n = (_ (C, M, pc)#(D,M',pc')#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Return;
cd = length cs;
i = stkLength P D M' (Suc pc') - 1 ⟧
⟹ Stk cd i ∈ Def P n"
| Def_IAdd_Stk:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = IAdd;
cd = length cs;
i = stkLength P C M pc - 2 ⟧
⟹ Stk cd i ∈ Def P n"
| Def_CmpEq_Stk:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = CmpEq;
cd = length cs;
i = stkLength P C M pc - 2 ⟧
⟹ Stk cd i ∈ Def P n"
inductive_set Use :: "wf_jvmprog ⇒ j_node ⇒ jinja_var set"
for P :: "wf_jvmprog"
and n :: "j_node"
where
Use_Load:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Load idx;
cd = length cs ⟧
⟹ (Loc cd idx) ∈ Use P n"
| Use_Store:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Store idx;
cd = length cs;
Suc i = (stkLength P C M pc) ⟧
⟹ (Stk cd i) ∈ Use P n"
| Use_New:
"⟦ n = (_ (C, M, pc)#cs,x _);
x = None ∨ x = ⌊(cs',False)⌋;
instrs_of (P⇘wf⇙) C M ! pc = New Cl ⟧
⟹ HeapVar a ∈ Use P n"
| Use_Getfield_Stk:
"⟦ n = (_ (C, M, pc)#cs,x _);
x = None ∨ x = ⌊(cs',False)⌋;
instrs_of (P⇘wf⇙) C M ! pc = Getfield Fd Cl;
cd = length cs;
Suc i = stkLength P C M pc ⟧
⟹ Stk cd i ∈ Use P n"
| Use_Getfield_Heap:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',False)⌋ _);
instrs_of (P⇘wf⇙) C M ! pc = Getfield Fd Cl ⟧
⟹ HeapVar a ∈ Use P n"
| Use_Putfield_Stk_Pred:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Putfield Fd Cl;
cd = length cs;
i = stkLength P C M pc - 2 ⟧
⟹ Stk cd i ∈ Use P n"
| Use_Putfield_Stk_Update:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',False)⌋ _);
instrs_of (P⇘wf⇙) C M ! pc = Putfield Fd Cl;
cd = length cs;
i = stkLength P C M pc - 2 ∨ i = stkLength P C M pc - 1 ⟧
⟹ Stk cd i ∈ Use P n"
| Use_Putfield_Heap:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',False)⌋ _);
instrs_of (P⇘wf⇙) C M ! pc = Putfield Fd Cl ⟧
⟹ HeapVar a ∈ Use P n"
| Use_Checkcast_Stk:
"⟦ n = (_ (C, M, pc)#cs,x _);
x = None ∨ x = ⌊(cs',False)⌋;
instrs_of (P⇘wf⇙) C M ! pc = Checkcast Cl;
cd = length cs;
i = stkLength P C M pc - Suc 0 ⟧
⟹ Stk cd i ∈ Use P n"
| Use_Checkcast_Heap:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Checkcast Cl ⟧
⟹ HeapVar a ∈ Use P n"
| Use_Invoke_Stk_Pred:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Invoke M' n';
cd = length cs;
i = stkLength P C M pc - Suc n' ⟧
⟹ Stk cd i ∈ Use P n"
| Use_Invoke_Heap_Pred:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Invoke M' n' ⟧
⟹ HeapVar a ∈ Use P n"
| Use_Invoke_Stk_Update:
"⟦ n = (_ (C, M, pc)#cs,⌊(cs',False)⌋ _);
instrs_of (P⇘wf⇙) C M ! pc = Invoke M' n';
cd = length cs;
i < stkLength P C M pc;
i ≥ stkLength P C M pc - Suc n' ⟧
⟹ Stk cd i ∈ Use P n"
| Use_Return_Stk:
"⟦ n = (_ (C, M, pc)#(D,M',pc')#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = Return;
cd = Suc (length cs);
i = stkLength P C M pc - 1 ⟧
⟹ Stk cd i ∈ Use P n"
| Use_IAdd_Stk:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = IAdd;
cd = length cs;
i = stkLength P C M pc - 1 ∨ i = stkLength P C M pc - 2 ⟧
⟹ Stk cd i ∈ Use P n"
| Use_IfFalse_Stk:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = (IfFalse b);
cd = length cs;
i = stkLength P C M pc - 1 ⟧
⟹ Stk cd i ∈ Use P n"
| Use_CmpEq_Stk:
"⟦ n = (_ (C, M, pc)#cs,None _);
instrs_of (P⇘wf⇙) C M ! pc = CmpEq;
cd = length cs;
i = stkLength P C M pc - 1 ∨ i = stkLength P C M pc - 2 ⟧
⟹ Stk cd i ∈ Use P n"
| Use_Throw_Stk:
"⟦ n = (_ (C, M, pc)#cs,x _);
x = None ∨ x = ⌊(cs',True)⌋;
instrs_of (P⇘wf⇙) C M ! pc = Throw;
cd = length cs;
i = stkLength P C M pc - 1 ⟧
⟹ Stk cd i ∈ Use P n"
| Use_Throw_Heap:
"⟦ n = (_ (C, M, pc)#cs,x _);
x = None ∨ x = ⌊(cs',True)⌋;
instrs_of (P⇘wf⇙) C M ! pc = Throw ⟧
⟹ HeapVar a ∈ Use P n"
declare correct_state_def [simp del]
lemma edge_transfer_uses_only_Use:
"⟦valid_edge (P,C0,Main) a; ∀V ∈ Use P (sourcenode a). state_val s V = state_val s' V⟧
⟹ ∀V ∈ Def P (sourcenode a). state_val (BasicDefs.transfer (kind a) s) V =
state_val (BasicDefs.transfer (kind a) s') V"
proof
fix V
assume ve: "valid_edge (P, C0, Main) a"
and use_eq: "∀V∈Use P (sourcenode a). state_val s V = state_val s' V"
and v_in_def: "V ∈ Def P (sourcenode a)"
obtain h stk loc where [simp]: "s = (h,stk,loc)" by (cases s, fastforce)
obtain h' stk' loc' where [simp]: "s' = (h',stk',loc')" by (cases s', fastforce)
note P_wf = wf_jvmprog_is_wf [of P]
from ve
have ex_edge: "(P,C0,Main) ⊢ (sourcenode a)-kind a→(targetnode a)"
and vn: "valid_node (P,C0,Main) (sourcenode a)"
by simp_all
show "state_val (transfer (kind a) s) V = state_val (transfer (kind a) s') V"
proof (cases "sourcenode a")
case [simp]: (Node cs x)
from vn ex_edge have "cs ≠ []"
by (cases x, auto elim: JVM_CFG.cases)
then obtain C M pc cs' where [simp]: "cs = (C, M, pc)#cs'" by (cases cs, fastforce+)
with vn obtain ST LT where wt: "((P⇘Φ⇙) C M ! pc) = ⌊(ST,LT)⌋"
by (cases cs', (cases x, auto)+)
show ?thesis
proof (cases "instrs_of (P⇘wf⇙) C M ! pc")
case [simp]: (Load n)
from ex_edge have [simp]: "x = None"
by (auto elim!: JVM_CFG.cases)
hence "Loc (length cs') n ∈ Use P (sourcenode a)"
by (auto intro!: Use_Load)
with use_eq have "state_val s (Loc (length cs') n) = state_val s' (Loc (length cs') n)"
by (simp del: state_val.simps)
with v_in_def ex_edge show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases
simp: split_beta)
next
case [simp]: (Store n)
from ex_edge have [simp]:"x = None"
by (auto elim!: JVM_CFG.cases)
have "ST ≠ []"
proof -
from vn
obtain Ts T mxs mxl "is" xt
where C_sees_M: "P⇘wf⇙ ⊢ C sees M: Ts→T = (mxs, mxl, is, xt) in C"
by (cases cs', auto)
with vn
have "pc < length is"
by (cases cs', auto dest: sees_method_fun)
from P_wf C_sees_M
have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with Store C_sees_M wt ‹pc < length is›
show ?thesis
by (fastforce simp: wt_method_def)
qed
then obtain ST1 STr where [simp]: "ST = ST1#STr"
by (cases ST, fastforce+)
from wt
have "Stk (length cs') (length ST - 1) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use_src")
by -(rule Use_Store, fastforce+)
with use_eq have "state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
with v_in_def ex_edge wt show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases
simp: split_beta)
next
case [simp]: (Push val)
from ex_edge have "x = None"
by (auto elim!: JVM_CFG.cases)
with v_in_def ex_edge show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases)
next
case [simp]: (New Cl)
show ?thesis
proof (cases x)
case None
with v_in_def have False
by (auto elim: Def.cases)
thus ?thesis by simp
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
have "¬ xf ⟶ (∀addr. HeapVar addr ∈ Use P (sourcenode a))"
by (fastforce intro: Use_New)
with use_eq
have "¬ xf ⟶ (∀addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr))"
by (simp del: state_val.simps)
hence "¬ xf ⟶ h = h'"
by (auto intro: ext)
with v_in_def ex_edge show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases)
qed
next
case [simp]: (Getfield Fd Cl)
show ?thesis
proof (cases x)
case None
with v_in_def have False
by (auto elim: Def.cases)
thus ?thesis by simp
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
have "ST ≠ []"
proof -
from vn obtain T Ts mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (cases cs', auto)
with vn
have "pc < length is"
by (cases cs', auto dest: sees_method_fun)
from P_wf sees_M have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with Getfield sees_M wt ‹pc < length is› show ?thesis
by (fastforce simp: wt_method_def)
qed
then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce)
from wt
have "¬ xf ⟶ (Stk (length cs') (length ST - 1) ∈ Use P (sourcenode a))"
(is "?xf ⟶ ?stk_top ∈ ?Use_src")
by (auto intro!: Use_Getfield_Stk)
with use_eq
have stk_top_eq: "¬ xf ⟶ state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
have "¬ xf ⟶ (∀addr. HeapVar addr ∈ Use P (sourcenode a))"
by (auto intro!: Use_Getfield_Heap)
with use_eq
have "¬ xf ⟶ (∀addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr))"
by (simp del: state_val.simps)
hence "¬ xf ⟶ h = h'"
by (auto intro: ext)
with ex_edge v_in_def stk_top_eq wt
show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases
simp: split_beta)
qed
next
case [simp]: (Putfield Fd Cl)
show ?thesis
proof (cases x)
case None
with v_in_def have False
by (auto elim: Def.cases)
thus ?thesis by simp
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
have "length ST > 1"
proof -
from vn obtain T Ts mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (cases cs', auto)
with vn
have "pc < length is"
by (cases cs', auto dest: sees_method_fun)
from P_wf sees_M have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with Putfield sees_M ‹pc < length is› wt show ?thesis
by (fastforce simp: wt_method_def)
qed
then obtain ST1 STr' where "ST = ST1#STr' ∧ length STr' > 0"
by (cases ST, fastforce+)
then obtain ST2 STr where [simp]: "ST = ST1#ST2#STr"
by (cases STr', fastforce+)
from wt
have "¬ xf ⟶ (Stk (length cs') (length ST - 1) ∈ Use P (sourcenode a))"
(is "?xf ⟶ ?stk_top ∈ ?Use_src")
by (fastforce intro: Use_Putfield_Stk_Update)
with use_eq have stk_top:"(¬ xf) ⟶ state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
from wt
have "¬ xf ⟶ (Stk (length cs') (length ST - 2) ∈ Use P (sourcenode a))"
(is "?xf ⟶ ?stk_nxt ∈ ?Use_src")
by (fastforce intro: Use_Putfield_Stk_Update)
with use_eq
have stk_nxt:"(¬ xf) ⟶ state_val s ?stk_nxt = state_val s' ?stk_nxt"
by (simp del: state_val.simps)
have "¬ xf ⟶ (∀addr. HeapVar addr ∈ Use P (sourcenode a))"
by (fastforce intro: Use_Putfield_Heap)
with use_eq
have "¬ xf ⟶ (∀addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr))"
by (simp del: state_val.simps)
hence "¬ xf ⟶ h = h'"
by (auto intro: ext)
with ex_edge v_in_def stk_top stk_nxt wt show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases
simp: split_beta)
qed
next
case [simp]: (Checkcast Cl)
show ?thesis
proof (cases x)
case None
with v_in_def have False
by (auto elim: Def.cases)
thus ?thesis by simp
next
case (Some x')
with ex_edge obtain cs''
where "x = ⌊(cs'',True)⌋"
by (auto elim!: JVM_CFG.cases)
with v_in_def ex_edge show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases)
qed
next
case [simp]: (Invoke M' n')
show ?thesis
proof (cases x)
case None
with v_in_def have False
by (auto elim: Def.cases)
thus ?thesis by simp
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
show ?thesis
proof (cases xf)
case True
with v_in_def ex_edge show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases)
next
case [simp]: False
have "length ST > n'"
proof -
from vn obtain T Ts mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (cases cs', auto)
with vn
have "pc < length is"
by (cases cs', auto dest: sees_method_fun)
from P_wf sees_M have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with Invoke sees_M ‹pc < length is› wt show ?thesis
by (fastforce simp: wt_method_def)
qed
moreover obtain STn where "STn = take n' ST" by fastforce
moreover obtain STs where "STs = ST ! n'" by fastforce
moreover obtain STr where "STr = drop (Suc n') ST" by fastforce
ultimately have [simp]:" ST = STn@STs#STr ∧ length STn = n'"
by (auto simp: id_take_nth_drop)
from wt
have "∀i. i ≤ n' ⟶ Stk (length cs') (length ST - Suc i) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Invoke_Stk_Update)
with use_eq
have
"∀i. i ≤ n' ⟶ state_val s (Stk (length cs') (length ST - Suc i)) =
state_val s' (Stk (length cs') (length ST - Suc i))"
by (simp del: state_val.simps)
hence stk_eq:
"∀i. i ≤ n' ⟶ state_val s (Stk (length cs') (i + length STr)) =
state_val s' (Stk (length cs') (i + length STr))"
by (clarsimp, erule_tac x="n' - i" in allE, auto simp: add.commute)
from ex_edge obtain C'
where trg: "targetnode a = (_ (C',M',0)#(C, M, pc)#cs',None _)"
by (fastforce elim: JVM_CFG.cases)
with ex_edge stk_eq v_in_def wt
show ?thesis
by (auto elim!: Def.cases) (erule JVM_CFG.cases, auto simp: split_beta add.commute)
qed
qed
next
case [simp]: Return
show ?thesis
proof (cases x)
case [simp]: None
show ?thesis
proof (cases cs')
case Nil
with v_in_def show ?thesis
by (auto elim!: Def.cases)
next
case (Cons aa list)
then obtain C' M' pc' cs'' where [simp]: "cs' = (C',M',pc')#cs''"
by (cases aa, fastforce)
from wt
have "Stk (length cs') (length ST - 1) ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Return_Stk)
with use_eq
have "state_val s (Stk (length cs') (length ST - 1)) =
state_val s' (Stk (length cs') (length ST - 1))"
by (simp del: state_val.simps)
with v_in_def ex_edge wt show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases
simp: split_beta)
qed
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case Pop
with v_in_def ex_edge show ?thesis
by (auto elim!: Def.cases elim: JVM_CFG.cases)
next
case [simp]: IAdd
show ?thesis
proof (cases x)
case [simp]: None
from wt
have "Stk (length cs') (length ST - 1) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (auto intro!: Use_IAdd_Stk)
with use_eq
have stk_top:"state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
from wt
have "Stk (length cs') (length ST - 2) ∈ Use P (sourcenode a)"
(is "?stk_snd ∈ ?Use")
by (auto intro!: Use_IAdd_Stk)
with use_eq
have stk_snd:"state_val s ?stk_snd = state_val s' ?stk_snd"
by (simp del: state_val.simps)
with v_in_def ex_edge stk_top wt show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases
simp: split_beta)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case [simp]: (IfFalse b)
show ?thesis
proof (cases x)
case [simp]: None
from wt
have "Stk (length cs') (length ST - 1) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (auto intro!: Use_IfFalse_Stk)
with use_eq
have stk_top:"state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
with v_in_def ex_edge wt show ?thesis
by (auto elim!: Def.cases)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case [simp]: CmpEq
show ?thesis
proof (cases x)
case [simp]: None
have "Stk (length cs') (stkLength P C M pc - 1) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (auto intro!: Use_CmpEq_Stk)
with use_eq
have stk_top:"state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
have "Stk (length cs') (stkLength P C M pc - 2) ∈ Use P (sourcenode a)"
(is "?stk_snd ∈ ?Use")
by (auto intro!: Use_CmpEq_Stk)
with use_eq
have stk_snd:"state_val s ?stk_snd = state_val s' ?stk_snd"
by (simp del: state_val.simps)
with v_in_def ex_edge stk_top wt show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case (Goto i)
with ex_edge v_in_def show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases)
next
case [simp]: Throw
show ?thesis
proof (cases x)
case [simp]: None
have "Stk (length cs') (stkLength P C M pc - 1) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (auto intro!: Use_Throw_Stk)
with use_eq
have stk_top:"state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
with v_in_def show ?thesis
by (auto elim!: Def.cases)
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
hence "xf ⟶ Stk (length cs') (stkLength P C M pc - 1) ∈ Use P (sourcenode a)"
(is "xf ⟶ ?stk_top ∈ ?Use")
by (fastforce intro: Use_Throw_Stk)
with use_eq
have stk_top:"xf ⟶ state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
with v_in_def ex_edge show ?thesis
by (auto elim!: Def.cases
elim: JVM_CFG.cases)
qed
qed
next
case Entry
with vn v_in_def show ?thesis
by -(erule Def.cases, auto)
qed
qed
lemma CFG_edge_Uses_pred_equal:
"⟦ valid_edge (P,C0,Main) a;
pred (kind a) s;
∀V ∈ Use P (sourcenode a). state_val s V = state_val s' V⟧
⟹ pred (kind a) s'"
proof -
assume ve: "valid_edge (P,C0,Main) a"
and pred: "pred (kind a) s"
and use_eq: "∀V∈Use P (sourcenode a). state_val s V = state_val s' V"
obtain h stk loc where [simp]: "s = (h,stk,loc)" by (cases s, blast)
obtain h' stk' loc' where [simp]: "s' = (h',stk',loc')" by (cases s', blast)
from ve
have vn: "valid_node (P,C0,Main) (sourcenode a)"
and ex_edge: "(P,C0,Main) ⊢ (sourcenode a)-kind a→(targetnode a)"
by simp_all
note P_wf = wf_jvmprog_is_wf [of P]
show "pred (kind a) s'"
proof (cases "sourcenode a")
case [simp]: (Node cs x)
from ve have "cs ≠ []"
by (cases x, auto elim: JVM_CFG.cases)
then obtain C M pc cs' where [simp]: "cs = (C, M, pc)#cs'" by (cases cs, fastforce+)
from vn obtain ST LT where wt: "((P⇘Φ⇙) C M ! pc) = ⌊(ST,LT)⌋"
by (cases cs', (cases x, auto)+)
show ?thesis
proof (cases "instrs_of (P⇘wf⇙) C M ! pc")
case (Load nat)
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Store nat)
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Push val)
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case [simp]: (New Cl)
show ?thesis
proof (cases x)
case None
hence "∀addr. HeapVar addr ∈ Use P (sourcenode a)"
by (auto intro!: Use_New)
with use_eq have "∀addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr)"
by (simp del: state_val.simps)
hence "h = h'"
by (auto intro: ext)
with ex_edge pred show ?thesis
by (auto elim!: JVM_CFG.cases)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case [simp]: (Getfield Fd Cl)
have "ST ≠ []"
proof -
from vn obtain T Ts mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (cases cs', (cases x, auto)+)
with vn
have "pc < length is"
by (cases cs', (cases x, auto dest: sees_method_fun)+)
from P_wf sees_M have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with Getfield wt sees_M ‹pc < length is› show ?thesis
by (fastforce simp: wt_method_def)
qed
then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
show ?thesis
proof (cases x)
case [simp]: None
from wt
have "Stk (length cs') (length ST - 1) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (fastforce intro: Use_Getfield_Stk)
with use_eq have "state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
with ex_edge pred wt show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case [simp]: (Putfield Fd Cl)
have "length ST > 1"
proof -
from vn obtain T Ts mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (cases cs', (cases x, auto)+)
with vn
have "pc < length is"
by (cases cs', (cases x, auto dest: sees_method_fun)+)
from P_wf sees_M have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with Putfield wt sees_M ‹pc < length is› show ?thesis
by (fastforce simp: wt_method_def)
qed
then obtain ST1 STr' where "ST = ST1#STr' ∧ STr' ≠ []" by (cases ST, fastforce+)
then obtain ST2 STr where [simp]: "ST = ST1#ST2#STr" by (cases STr', fastforce+)
show ?thesis
proof (cases x)
case [simp]: None
with wt
have "Stk (length cs') (length ST - 2) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (fastforce intro: Use_Putfield_Stk_Pred)
with use_eq have "state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
with ex_edge pred wt show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case [simp]: (Checkcast Cl)
have "ST ≠ []"
proof -
from vn obtain T Ts mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (cases cs', (cases x, auto)+)
with vn
have "pc < length is"
by (cases cs', (cases x, auto dest: sees_method_fun)+)
from P_wf sees_M have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with Checkcast wt sees_M ‹pc < length is› show ?thesis
by (fastforce simp: wt_method_def)
qed
then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
show ?thesis
proof (cases x)
case [simp]: None
from wt
have "Stk (length cs') (stkLength P C M pc - Suc 0) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (fastforce intro: Use_Checkcast_Stk)
with use_eq
have stk_top: "state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
have "∀addr. HeapVar addr ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Checkcast_Heap)
with use_eq
have "∀addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr)"
by (simp del: state_val.simps)
hence "h = h'"
by (auto intro: ext)
with ex_edge stk_top pred wt show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case [simp]: (Invoke M' n')
have "length ST > n'"
proof -
from vn obtain T Ts mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (cases cs', (cases x, auto)+)
with vn
have "pc < length is"
by (cases cs', (cases x, auto dest: sees_method_fun)+)
from P_wf sees_M have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with Invoke wt sees_M ‹pc < length is› show ?thesis
by (fastforce simp: wt_method_def)
qed
moreover obtain STn where "STn = take n' ST" by fastforce
moreover obtain STs where "STs = ST ! n'" by fastforce
moreover obtain STr where "STr = drop (Suc n') ST" by fastforce
ultimately have [simp]:" ST = STn@STs#STr ∧ length STn = n'"
by (auto simp: id_take_nth_drop)
show ?thesis
proof (cases x)
case [simp]: None
with wt
have "Stk (length cs') (stkLength P C M pc - Suc n') ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (fastforce intro: Use_Invoke_Stk_Pred)
with use_eq
have stk_top: "state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
have "∀addr. HeapVar addr ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Invoke_Heap_Pred)
with use_eq
have "∀addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr)"
by (simp del: state_val.simps)
hence "h = h'"
by (auto intro: ext)
with ex_edge stk_top pred wt show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case Return
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case Pop
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case IAdd
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case [simp]: (IfFalse b)
show ?thesis
proof (cases x)
case [simp]: None
have "Stk (length cs') (stkLength P C M pc - 1) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (fastforce intro: Use_IfFalse_Stk)
with use_eq
have "state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
with ex_edge pred wt show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
next
case CmpEq
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Goto i)
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case [simp]: Throw
have "ST ≠ []"
proof -
from vn obtain T Ts mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (cases cs', (cases x, auto)+)
with vn
have "pc < length is"
by (cases cs', (cases x, auto dest: sees_method_fun)+)
from P_wf sees_M have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with Throw wt sees_M ‹pc < length is› show ?thesis
by (fastforce simp: wt_method_def)
qed
then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
show ?thesis
proof (cases x)
case [simp]: None
from wt
have "Stk (length cs') (stkLength P C M pc - 1) ∈ Use P (sourcenode a)"
(is "?stk_top ∈ ?Use")
by (fastforce intro: Use_Throw_Stk)
with use_eq
have stk_top: "state_val s ?stk_top = state_val s' ?stk_top"
by (simp del: state_val.simps)
have "∀addr. HeapVar addr ∈ Use P (sourcenode a)"
by (fastforce intro: Use_Throw_Heap)
with use_eq
have "∀addr. state_val s (HeapVar addr) = state_val s' (HeapVar addr)"
by (simp del: state_val.simps)
hence "h = h'"
by (auto intro: ext)
with ex_edge pred stk_top wt show ?thesis
by (auto elim!: JVM_CFG.cases)
next
case (Some x')
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
qed
next
case Entry
with ex_edge pred show ?thesis
by (auto elim: JVM_CFG.cases)
qed
qed
lemma edge_no_Def_equal:
"⟦ valid_edge (P, C0, Main) a;
V ∉ Def P (sourcenode a) ⟧
⟹ state_val (transfer (kind a) s) V = state_val s V"
proof -
assume ve:"valid_edge (P, C0, Main) a"
and v_not_def: "V ∉ Def P (sourcenode a)"
obtain h stk loc where [simp]: "(s::state) = (h, stk, loc)" by (cases s, blast)
from ve have vn: "valid_node (P, C0, Main) (sourcenode a)"
and ex_edge: "(P, C0, Main) ⊢ (sourcenode a)-kind a→(targetnode a)"
by simp_all
show "state_val (transfer (kind a) s) V = state_val s V"
proof (cases "sourcenode a")
case [simp]: (Node cs x)
with ve have "cs ≠ []"
by (cases x, auto elim: JVM_CFG.cases)
then obtain C M pc cs' where [simp]: "cs = (C, M, pc)#cs'" by (cases cs, fastforce+)
with vn obtain ST LT where wt: "((P⇘Φ⇙) C M ! pc) = ⌊(ST,LT)⌋"
by (cases cs', (cases x, auto)+)
show ?thesis
proof (cases "instrs_of (P⇘wf⇙) C M ! pc")
case [simp]: (Load nat)
from ex_edge have "x = None"
by (auto elim: JVM_CFG.cases)
with v_not_def have "V ≠ Stk (length cs') (stkLength P C M pc)"
by (auto intro!: Def_Load)
with ex_edge show ?thesis
by (auto elim!: JVM_CFG.cases, cases V, auto)
next
case [simp]: (Store nat)
with ex_edge have "x = None"
by (auto elim: JVM_CFG.cases)
with v_not_def have "V ≠ Loc (length cs') nat"
by (auto intro!: Def_Store)
with ex_edge show ?thesis
by (auto elim!: JVM_CFG.cases, cases V, auto)
next
case [simp]: (Push val)
with ex_edge have "x = None"
by (auto elim: JVM_CFG.cases)
with v_not_def have "V ≠ Stk (length cs') (stkLength P C M pc)"
by (auto intro!: Def_Push)
with ex_edge show ?thesis
by (auto elim!: JVM_CFG.cases, cases V, auto)
next
case [simp]: (New Cl)
show ?thesis
proof (cases x)
case None
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
with ex_edge v_not_def show ?thesis
apply (auto elim!: JVM_CFG.cases)
apply (cases V, auto intro!: Def_New_Normal_Stk Def_New_Normal_Heap)
by (cases V, auto intro!: Def_Exc_Stk)+
qed
next
case [simp]: (Getfield F Cl)
show ?thesis
proof (cases x)
case None
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
with ex_edge v_not_def show ?thesis
apply (auto elim!: JVM_CFG.cases simp: split_beta)
apply (cases V, auto intro!: Def_Getfield_Stk)
by (cases V, auto intro!: Def_Exc_Stk)+
qed
next
case [simp]: (Putfield Fd Cl)
show ?thesis
proof (cases x)
case None
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
with ex_edge v_not_def show ?thesis
apply (auto elim!: JVM_CFG.cases simp: split_beta)
apply (cases V, auto intro!: Def_Putfield_Heap)
by (cases V, auto intro!: Def_Exc_Stk)+
qed
next
case [simp]: (Checkcast Cl)
show ?thesis
proof (cases x)
case None
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
with ex_edge v_not_def show ?thesis
apply (auto elim!: JVM_CFG.cases)
by (cases V, auto intro!: Def_Exc_Stk)+
qed
next
case [simp]: (Invoke M' n')
show ?thesis
proof (cases x)
case None
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
from ex_edge v_not_def show ?thesis
apply (auto elim!: JVM_CFG.cases)
apply (cases V, auto intro!: Def_Invoke_Loc)
by (cases V, auto intro!: Def_Exc_Stk)+
qed
next
case Return
with ex_edge v_not_def show ?thesis
apply (auto elim!: JVM_CFG.cases)
by (cases V, auto intro!: Def_Return_Stk)
next
case Pop
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case IAdd
with ex_edge v_not_def show ?thesis
apply (auto elim!: JVM_CFG.cases)
by (cases V, auto intro!: Def_IAdd_Stk)
next
case (IfFalse b)
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case CmpEq
with ex_edge v_not_def show ?thesis
apply (auto elim!: JVM_CFG.cases)
by (cases V, auto intro!: Def_CmpEq_Stk)
next
case (Goto i)
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case [simp]: Throw
show ?thesis
proof (cases x)
case None
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
next
case (Some x')
then obtain cs'' xf where [simp]: "x = ⌊(cs'',xf)⌋"
by (cases x', fastforce)
from ex_edge v_not_def show ?thesis
apply (auto elim!: JVM_CFG.cases)
by (cases V, auto intro!: Def_Exc_Stk)+
qed
qed
next
case Entry
with ex_edge show ?thesis
by (auto elim: JVM_CFG.cases)
qed
qed
interpretation JVM_CFG_wf: CFG_wf
"sourcenode" "targetnode" "kind" "valid_edge prog" "(_Entry_)"
"Def (fst prog)" "Use (fst prog)" "state_val"
for prog
proof (unfold_locales)
show "Def (fst prog) (_Entry_) = {} ∧ Use (fst prog) (_Entry_) = {}"
by (auto elim: Def.cases Use.cases)
next
fix a V s
assume ve:"valid_edge prog a"
and v_not_def: "V ∉ Def (fst prog) (sourcenode a)"
thus "state_val (transfer (kind a) s) V = state_val s V"
by -(cases prog,
rule edge_no_Def_equal [of "fst prog" "fst (snd prog)" "snd (snd prog)"], auto)
next
fix a s s'
assume ve: "valid_edge prog a"
and use_eq: "∀V∈Use (fst prog) (sourcenode a). state_val s V = state_val s' V"
thus "∀V∈Def (fst prog) (sourcenode a).
state_val (transfer (kind a) s) V = state_val (transfer (kind a) s') V"
by -(cases prog,
rule edge_transfer_uses_only_Use [of "fst prog" "fst(snd prog)" "snd(snd prog)"], auto)
next
fix a s s'
assume ve: "valid_edge prog a"
and pred: "pred (kind a) s"
and use_eq: "∀V∈Use (fst prog) (sourcenode a). state_val s V = state_val s' V"
thus "pred (kind a) s'"
by -(cases prog,
rule CFG_edge_Uses_pred_equal [of "fst prog" "fst(snd prog)" "snd(snd prog)"], auto)
next
fix a a'
assume ve_a: "valid_edge prog a"
and ve_a': "valid_edge prog a'"
and src_eq: "sourcenode a = sourcenode a'"
and trg_neq: "targetnode a ≠ targetnode a'"
hence "prog ⊢ (sourcenode a)-kind a→(targetnode a)"
and "prog ⊢ (sourcenode a')-kind a'→(targetnode a')"
by simp_all
with src_eq trg_neq
show "∃Q Q'. kind a = (Q)⇩√ ∧ kind a' = (Q')⇩√ ∧ (∀s. (Q s ⟶ ¬ Q' s) ∧ (Q' s ⟶ ¬ Q s))"
apply (cases prog, auto)
apply (erule JVM_CFG.cases, erule_tac [!] JVM_CFG.cases)
by simp_all
qed
interpretation JVM_CFGExit_wf: CFGExit_wf
"sourcenode" "targetnode" "kind" "valid_edge prog" "(_Entry_)"
"Def (fst prog)" "Use (fst prog)" "state_val" "(_Exit_)"
proof
show "Def (fst prog) (_Exit_) = {} ∧ Use (fst prog) (_Exit_) = {}"
by(fastforce elim:Def.cases Use.cases)
qed
end
Theory JVMControlDependences
section ‹Instantiating the control dependences›
theory JVMControlDependences imports
JVMPostdomination
JVMCFG_wf
"../Dynamic/DynPDG"
"../StaticIntra/CDepInstantiations"
begin
subsection ‹Dynamic dependences›
interpretation JVMDynStandardControlDependence:
DynStandardControlDependencePDG "sourcenode" "targetnode" "kind"
"valid_edge⇘CFG⇙ prog" "(_Entry_)" "Def (fst⇘CFG⇙ prog)" "Use (fst⇘CFG⇙ prog)"
"state_val" "(_Exit_)" ..
interpretation JVMDynWeakControlDependence:
DynWeakControlDependencePDG "sourcenode" "targetnode" "kind"
"valid_edge⇘CFG⇙ prog" "(_Entry_)" "Def (fst⇘CFG⇙ prog)" "Use (fst⇘CFG⇙ prog)"
"state_val" "(_Exit_)" ..
subsection ‹Static dependences›
interpretation JVMStandardControlDependence:
StandardControlDependencePDG "sourcenode" "targetnode" "kind"
"valid_edge⇘CFG⇙ prog" "(_Entry_)" "Def (fst⇘CFG⇙ prog)" "Use (fst⇘CFG⇙ prog)"
"state_val" "(_Exit_)" ..
interpretation JVMWeakControlDependence:
WeakControlDependencePDG "sourcenode" "targetnode" "kind"
"valid_edge⇘CFG⇙ prog" "(_Entry_)" "Def (fst⇘CFG⇙ prog)" "Use (fst⇘CFG⇙ prog)"
"state_val" "(_Exit_)" ..
end
Theory SemanticsWF
chapter ‹Equivalence of the CFG and Jinja›
theory SemanticsWF imports JVMInterpretation "../Basic/SemanticsCFG" begin
declare rev_nth [simp add]
section ‹State updates›
text ‹
The following abbreviations update the stack and the local variables (in the representation
as used in the CFG) according to a ‹frame list› as it is used in Jinja's
state representation.
›
abbreviation update_stk :: "((nat × nat) ⇒ val) ⇒ (frame list) ⇒ ((nat × nat) ⇒ val)"
where
"update_stk stk frs ≡ (λ(a, b).
if length frs ≤ a then stk (a, b)
else let xs = fst (frs ! (length frs - Suc a))
in if length xs ≤ b then stk (a, b) else xs ! (length xs - Suc b))"
abbreviation update_loc :: "((nat × nat) ⇒ val) ⇒ (frame list) ⇒ ((nat × nat) ⇒ val)"
where
"update_loc loc frs ≡ (λ(a, b).
if length frs ≤ a then loc (a, b)
else let xs = fst (snd (frs ! (length frs - Suc a)))
in if length xs ≤ b then loc (a, b) else xs ! b)"
subsection ‹Some simplification lemmas›
lemma update_loc_s2jvm [simp]:
"update_loc loc (snd(snd(state_to_jvm_state P cs (h,stk,loc)))) = loc"
by (auto intro!: ext simp: nth_locss)
lemma update_stk_s2jvm [simp]:
"update_stk stk (snd(snd(state_to_jvm_state P cs (h,stk,loc)))) = stk"
by (auto intro!: ext simp: nth_stkss)
lemma update_loc_s2jvm' [simp]:
"update_loc loc (zip (stkss P cs stk) (zip (locss P cs loc) cs)) = loc"
by (auto intro!: ext simp: nth_locss)
lemma update_stk_s2jvm' [simp]:
"update_stk stk (zip (stkss P cs stk) (zip (locss P cs loc) cs)) = stk"
by (auto intro!: ext simp: nth_stkss)
lemma find_handler_find_handler_forD:
"find_handler (P⇘wf⇙) a h frs = (xp',h',frs')
⟹ find_handler_for P (cname_of h a) (framestack_to_callstack frs) =
framestack_to_callstack frs'"
by (induct frs, auto)
lemma find_handler_nonempty_frs [simp]:
"(find_handler P a h frs ≠ (None, h', []))"
by (induct frs, auto)
lemma find_handler_heap_eqD:
"find_handler P a h frs = (xp, h', frs') ⟹ h' = h"
by (induct frs, auto)
lemma find_handler_frs_decrD:
"find_handler P a h frs = (xp, h', frs') ⟹ length frs' ≤ length frs"
by (induct frs, auto)
lemma find_handler_decrD [dest]:
"find_handler P a h frs = (xp, h', f#frs) ⟹ False"
by (drule find_handler_frs_decrD, simp)
lemma find_handler_decrD' [dest]:
"⟦ find_handler P a h frs = (xp,h',f#frs'); length frs = length frs' ⟧ ⟹ False"
by (drule find_handler_frs_decrD, simp)
lemma Suc_minus_Suc_Suc [simp]:
"b < n - 1 ⟹ Suc (n - Suc (Suc b)) = n - Suc b"
by simp
lemma find_handler_loc_fun_eq':
"find_handler (P⇘wf⇙) a h
(zip (stkss P cs stk) (zip (locss P cs loc) cs)) =
(xf, h', frs)
⟹ update_loc loc frs = loc"
proof
fix x
obtain a' b' where x: "x = (a'::nat,b'::nat)" by fastforce
assume find_handler: "find_handler (P⇘wf⇙) a h
(zip (stkss P cs stk) (zip (locss P cs loc) cs)) =
(xf, h', frs)"
thus "update_loc loc frs x = loc x"
proof (induct cs)
case Nil
thus ?case by simp
next
case (Cons aa cs')
then obtain C M pc where step_case: "find_handler (P⇘wf⇙) a h
(zip (stkss P ((C,M,pc) # cs') stk)
(zip (locss P ((C,M,pc) # cs') loc) ((C,M,pc) # cs'))) =
(xf, h', frs)"
by (cases aa, clarsimp)
note IH = ‹find_handler (P⇘wf⇙) a h
(zip (stkss P cs' stk) (zip (locss P cs' loc) cs')) =
(xf, h', frs) ⟹
update_loc loc frs x = loc x›
show ?thesis
proof (cases "match_ex_table (P⇘wf⇙) (cname_of h a) pc (ex_table_of (P⇘wf⇙) C M)")
case None
with step_case IH show ?thesis
by simp
next
case (Some e)
with step_case x
show ?thesis
by (cases "length cs' = a'",
auto simp: nth_Cons' nth_locss)
qed
qed
qed
lemma find_handler_loc_fun_eq:
"find_handler (P⇘wf⇙) a h (snd(snd(state_to_jvm_state P cs (h,stk,loc)))) = (xf,h',frs)
⟹ update_loc loc frs = loc"
by (simp add: find_handler_loc_fun_eq')
lemma find_handler_stk_fun_eq':
"⟦find_handler (P⇘wf⇙) a h
(zip (stkss P cs stk) (zip (locss P cs loc) cs)) =
(None, h', frs);
cd = length frs - 1;
i = length (fst(hd(frs))) - 1 ⟧
⟹ update_stk stk frs = stk((cd, i) := Addr a)"
proof
fix x
obtain a' b' where x: "x = (a'::nat,b'::nat)" by fastforce
assume find_handler: "find_handler (P⇘wf⇙) a h
(zip (stkss P cs stk) (zip (locss P cs loc) cs)) =
(None, h', frs)"
and calldepth: "cd = length frs - 1"
and idx: "i = length (fst (hd frs)) - 1"
from find_handler have "frs ≠ []"
by clarsimp
then obtain stk' loc' C' M' pc' frs' where frs: "frs = (stk',loc',C',M',pc')#frs'"
by (cases frs, fastforce+)
from find_handler
show "update_stk stk frs x = (stk((cd, i) := Addr a)) x"
proof (induct cs)
case Nil
thus ?case by simp
next
case (Cons aa cs')
then obtain C M pc where step_case: "find_handler (P⇘wf⇙) a h
(zip (stkss P ((C,M,pc) # cs') stk)
(zip (locss P ((C,M,pc) # cs') loc) ((C,M,pc) # cs'))) =
(None, h', frs)"
by (cases aa, clarsimp)
note IH = ‹find_handler (P⇘wf⇙) a h
(zip (stkss P cs' stk) (zip (locss P cs' loc) cs')) =
(None, h', frs) ⟹
update_stk stk frs x = (stk((cd, i) := Addr a)) x›
show ?thesis
proof (cases "match_ex_table (P⇘wf⇙) (cname_of h a) pc (ex_table_of (P⇘wf⇙) C M)")
case None
with step_case IH show ?thesis
by simp
next
case (Some e)
show ?thesis
proof (cases "a' = length cs'")
case True
with Some step_case frs calldepth idx x
show ?thesis
by (fastforce simp: nth_Cons')
next
case False
with Some step_case frs calldepth idx x
show ?thesis
by (fastforce simp: nth_Cons' nth_stkss)
qed
qed
qed
qed
lemma find_handler_stk_fun_eq:
"find_handler (P⇘wf⇙) a h (snd(snd(state_to_jvm_state P cs (h,stk,loc)))) = (None,h',frs)
⟹ update_stk stk frs = stk((length frs - 1, length (fst(hd(frs))) - 1) := Addr a)"
by (simp add: find_handler_stk_fun_eq')
lemma f2c_emptyD [dest]:
"framestack_to_callstack frs = [] ⟹ frs = []"
by (simp add: framestack_to_callstack_def)
lemma f2c_emptyD' [dest]:
"[] = framestack_to_callstack frs ⟹ frs = []"
by (simp add: framestack_to_callstack_def)
lemma correct_state_imp_valid_callstack:
"⟦ P,cs ⊢⇘BV⇙ s √; fst (last cs) = C0; fst(snd (last cs)) = Main ⟧
⟹ valid_callstack (P,C0,Main) cs"
proof (cases cs rule: rev_cases)
case Nil
thus ?thesis by simp
next
case (snoc cs' y)
assume bv_correct: "P,cs ⊢⇘BV⇙ s √"
and last_C: "fst (last cs) = C0"
and last_M: "fst(snd (last cs)) = Main"
with snoc obtain pcX where [simp]: "cs = cs'@[(C0,Main,pcX)]"
by (cases "last cs", fastforce)
obtain h stk loc where [simp]: "s = (h,stk,loc)"
by (cases s, fastforce)
from bv_correct show ?thesis
proof (cases "snd(snd(state_to_jvm_state P cs s))")
case Nil
thus ?thesis
by (cases cs', auto)
next
case [simp]: (Cons a frs')
obtain stk' loc' C M pc where [simp]: "a = (stk', loc', C, M, pc)" by (cases a, fastforce)
from Cons bv_correct show ?thesis
apply clarsimp
proof (induct cs' arbitrary: stk' loc' C M pc frs')
case Nil
thus ?case by (fastforce simp: bv_conform_def)
next
case (Cons a' cs'')
then have [simp]: "a' = (C,M,pc)"
by (cases a', fastforce)
from Cons obtain T Ts mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (clarsimp simp: bv_conform_def correct_state_def)
with Cons
have "pc < length is"
by (auto dest: sees_method_fun
simp: bv_conform_def)
from wf_jvmprog_is_wf [of P] sees_M
have "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with ‹pc < length is› sees_M
have "length Ts = locLength P C M 0 - Suc mxl"
by (auto dest!: list_all2_lengthD
simp: wt_method_def wt_start_def)
with Cons sees_M show ?case
by (cases cs'',
(fastforce dest: sees_method_fun simp: bv_conform_def)+)
qed
qed
qed
declare correct_state_def [simp del]
lemma bool_sym: "Bool (a = b) = Bool (b = a)"
by auto
lemma find_handler_exec_correct:
"⟦(P⇘wf⇙),(P⇘Φ⇙) ⊢ state_to_jvm_state P cs (h,stk,loc) √;
(P⇘wf⇙),(P⇘Φ⇙) ⊢ find_handler (P⇘wf⇙) a h
(zip (stkss P cs stk) (zip (locss P cs loc) cs)) √;
find_handler_for P (cname_of h a) cs = (C', M', pc') # cs'
⟧ ⟹
(P⇘wf⇙),(P⇘Φ⇙) ⊢ (None, h,
(stks (stkLength P C' M' pc')
(λa'. (stk((length cs', stkLength P C' M' pc' - Suc 0) := Addr a)) (length cs', a')),
locs (locLength P C' M' pc') (λa. loc (length cs', a)), C', M', pc') #
zip (stkss P cs' stk) (zip (locss P cs' loc) cs')) √"
proof (induct cs)
case Nil
thus ?case by simp
next
case (Cons aa cs)
note state_correct = ‹P⇘wf⇙,P⇘Φ⇙ ⊢ state_to_jvm_state P (aa # cs) (h, stk, loc) √›
note IH = ‹⟦P⇘wf⇙,P⇘Φ⇙ ⊢ state_to_jvm_state P cs (h, stk, loc) √;
P⇘wf⇙,P⇘Φ⇙ ⊢ find_handler P⇘wf⇙ a h (zip (stkss P cs stk) (zip (locss P cs loc) cs)) √;
find_handler_for P (cname_of h a) cs = (C', M', pc') # cs'⟧
⟹ P⇘wf⇙,P⇘Φ⇙ ⊢ (None, h,
(stks (stkLength P C' M' pc')
(λa'. (stk((length cs', stkLength P C' M' pc' - Suc 0) := Addr a))
(length cs', a')),
locs (locLength P C' M' pc') (λa. loc (length cs', a)), C', M', pc') #
zip (stkss P cs' stk) (zip (locss P cs' loc) cs')) √›
note trg_state_correct = ‹P⇘wf⇙,P⇘Φ⇙ ⊢ find_handler P⇘wf⇙ a h
(zip (stkss P (aa # cs) stk)
(zip (locss P (aa # cs) loc) (aa # cs))) √›
note fhf = ‹find_handler_for P (cname_of h a) (aa # cs) = (C', M', pc') # cs'›
obtain C M pc where [simp]: "aa = (C,M,pc)" by (cases aa, fastforce)
note P_wf = wf_jvmprog_is_wf [of P]
from state_correct
have cs_state_correct: "P⇘wf⇙,P⇘Φ⇙ ⊢ state_to_jvm_state P cs (h, stk, loc) √"
apply (auto simp: correct_state_def)
apply (cases "zip (stkss P cs stk) (zip (locss P cs loc) cs)")
by fastforce+
show ?thesis
proof (cases "match_ex_table (P⇘wf⇙) (cname_of h a) pc (ex_table_of (P⇘wf⇙) C M)")
case None
with trg_state_correct fhf cs_state_correct IH show ?thesis
by clarsimp
next
case (Some xte)
with IH trg_state_correct fhf state_correct show ?thesis
apply (cases "stkLength P C' M' (fst xte)", auto)
apply (clarsimp simp: correct_state_def)
apply (auto simp: correct_state_def)
apply (rule_tac x="Ts" in exI)
apply (rule_tac x="T" in exI)
apply (rule_tac x="mxs" in exI)
apply (rule_tac x="mxl⇩0" in exI)
apply (rule_tac x="is" in exI)
apply (rule conjI)
apply (rule_tac x="xt" in exI)
apply clarsimp
apply clarsimp
apply (drule sees_method_fun, fastforce, clarsimp)
apply (auto simp: list_all2_Cons1)
apply (rule list_all2_all_nthI)
apply clarsimp
apply clarsimp
apply (frule_tac ys="zs" in list_all2_lengthD)
apply clarsimp
apply (drule_tac p="n" and ys="zs" in list_all2_nthD)
apply clarsimp
apply clarsimp
apply (case_tac "length aa - Suc (length aa - snd xte + n) = length zs - Suc n")
apply clarsimp
apply clarsimp
apply (rule list_all2_all_nthI)
apply clarsimp
apply (frule_tac p="n" and ys="b" in list_all2_nthD)
apply (clarsimp dest!: list_all2_lengthD)
by (clarsimp dest!: list_all2_lengthD)
qed
qed
lemma locs_rev_stks:
"x ≥ z ⟹
locs z
(λb.
if z < b then loc (Suc y, b)
else if b ≤ z
then stk (y, x + b - Suc z)
else arbitrary)
@ [stk (y, x - Suc 0)]
=
stk (y, x - Suc (z))
# rev (take z (stks x (λa. stk(y, a))))"
apply (rule nth_equalityI)
apply (simp)
apply (auto simp: nth_append nth_Cons' less_Suc_eq min.absorb2 max.absorb2)
done
lemma locs_invoke_purge:
"(z::nat) > c ⟹
locs l
(λb. if z = c ⟶ Q b then loc (c, b) else u b) =
locs l (λa. loc (c, a))"
by (induct l, auto)
lemma nth_rev_equalityI:
"⟦length xs = length ys; ∀i<length xs. xs ! (length xs - Suc i) = ys ! (length ys - Suc i)⟧
⟹ xs = ys"
proof (induct xs ys rule: list_induct2)
case Nil
thus ?case by simp
next
case (Cons x xs y ys)
hence "∀i<length ys. xs ! (length ys - Suc i) = ys ! (length ys - Suc i)"
apply auto
apply (erule_tac x="i" in allE)
by (auto simp: nth_Cons')
with Cons show ?case
by (auto simp: nth_Cons)
qed
lemma length_locss:
"i < length cs
⟹ length (locss P cs loc ! (length cs - Suc i)) =
locLength P (fst(cs ! (length cs - Suc i)))
(fst(snd(cs ! (length cs - Suc i))))
(snd(snd(cs ! (length cs - Suc i))))"
apply (induct cs, auto)
apply (case_tac "i = length cs")
by (auto simp: nth_Cons')
lemma locss_invoke_purge:
"z > length cs ⟹
locss P cs
(λ(a, b). if (a = z ⟶ Q b)
then loc (a, b)
else u b)
= locss P cs loc"
by (induct cs, auto simp: locs_invoke_purge [simplified])
lemma stks_purge':
"d ≥ b ⟹ stks b (λx. if x = d then e else stk x) = stks b stk"
by simp
subsection ‹Byte code verifier conformance›
text ‹Here we prove state conformance invariant under ‹transfer› for
our CFG. Therefore, we must assume, that the predicate of a potential preceding
predicate-edge holds for every update-edge.
›
theorem bv_invariant:
"⟦ valid_edge (P,C0,Main) a;
sourcenode a = (_ (C,M,pc)#cs,x _);
targetnode a = (_ (C',M',pc')#cs',x' _);
pred (kind a) s;
x ≠ None ⟶ (∃a_pred.
sourcenode a_pred = (_ (C,M,pc)#cs,None _) ∧
targetnode a_pred = sourcenode a ∧
valid_edge (P,C0,Main) a_pred ∧
pred (kind a_pred) s
);
P,((C,M,pc)#cs) ⊢⇘BV⇙ s √ ⟧
⟹ P,((C',M',pc')#cs') ⊢⇘BV⇙ transfer (kind a) s √"
proof -
assume ve: "valid_edge (P, C0, Main) a"
and src [simp]: "sourcenode a = (_ (C,M,pc)#cs,x _)"
and trg [simp]: "targetnode a = (_ (C',M',pc')#cs',x' _)"
and pred_s: "pred (kind a) s"
and a_pred: "x ≠ None ⟶ (∃a_pred.
sourcenode a_pred = (_ (C,M,pc)#cs,None _) ∧
targetnode a_pred = sourcenode a ∧
valid_edge (P,C0,Main) a_pred ∧
pred (kind a_pred) s
)"
and state_correct: "P,((C,M,pc)#cs) ⊢⇘BV⇙ s √"
obtain h stk loc where s [simp]: "s = (h,stk,loc)" by (cases s, fastforce)
note P_wf = wf_jvmprog_is_wf [of P]
from ve obtain Ts T mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
and "pc < length is"
and reachable: "P⇘Φ⇙ C M ! pc ≠ None"
by (cases x) (cases cs, auto)+
from P_wf sees_M
have wt_method: "wt_method (P⇘wf⇙) C Ts T mxs mxl is xt (P⇘Φ⇙ C M)"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with sees_M ‹pc < length is› reachable
have applicable: "app⇩i ((is ! pc),(P⇘wf⇙),pc,mxs,T,(the(P⇘Φ⇙ C M ! pc)))"
by (auto simp: wt_method_def)
from state_correct ve P_wf
have trg_state_correct:
"(P⇘wf⇙),(P⇘Φ⇙) ⊢ the (JVMExec.exec ((P⇘wf⇙), state_to_jvm_state P ((C,M,pc)#cs) s)) √"
apply simp
apply (drule BV_correct_1)
apply (fastforce simp: bv_conform_def)
apply (simp add: exec_1_iff)
apply (cases "instrs_of (P⇘wf⇙) C M ! pc")
apply (simp_all add: split_beta)
done
from reachable obtain ST LT where reachable: "(P⇘Φ⇙) C M ! pc = ⌊(ST, LT)⌋"
by fastforce
with wt_method sees_M ‹pc < length is›
have stk_loc_succs:
"∀pc' ∈ set (succs (is ! pc) (ST, LT) pc).
stkLength P C M pc' = length (fst (eff⇩i (is ! pc, (P⇘wf⇙), ST, LT))) ∧
locLength P C M pc' = length (snd (eff⇩i (is ! pc, (P⇘wf⇙), ST, LT)))"
unfolding wt_method_def apply (cases "is ! pc")
using [[simproc del: list_to_set_comprehension]]
apply (cases "is ! pc")
apply (tactic ‹PARALLEL_ALLGOALS
(Clasimp.fast_force_tac (@{context} addSDs @{thms list_all2_lengthD}))›)
done
have [simp]: "∃x. x" by auto
have [simp]: "Ex Not" by auto
show ?thesis
proof (cases "instrs_of (P⇘wf⇙) C M ! pc")
case (Invoke m n)
from state_correct have "preallocated h"
by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
from Invoke applicable sees_M have "stkLength P C M pc > n"
by (cases "the (P⇘Φ⇙ C M ! pc)") auto
show ?thesis
proof (cases x)
case [simp]: None
with ve Invoke obtain Q where kind: "kind a = (Q)⇩√"
by (auto elim!: JVM_CFG.cases)
with ve Invoke have "(C',M',pc')#cs' = (C,M,pc)#cs"
by (auto elim!: JVM_CFG.cases)
with state_correct kind show ?thesis
by simp
next
case [simp]: (Some aa)
with ve Invoke obtain xf where [simp]: "aa = ((C',M',pc')#cs' , xf)"
by (auto elim!: JVM_CFG.cases)
from ve Invoke obtain f where kind: "kind a = ⇑f"
apply -
apply clarsimp
apply (erule JVM_CFG.cases)
apply auto
done
show ?thesis
proof (cases xf)
case [simp]: True
with a_pred Invoke have stk_n: "stk (length cs, stkLength P C M pc - Suc n) = Null"
apply auto
apply (erule JVM_CFG.cases)
apply simp_all
done
from ve Invoke kind
have [simp]: "f = (λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) := Addr (addr_of_sys_xcpt NullPointer)),
loc))"
apply -
apply clarsimp
apply (erule JVM_CFG.cases)
apply auto
done
from ve Invoke
have "find_handler_for P NullPointer ((C,M,pc)#cs) = (C',M',pc')#cs'"
apply -
apply clarsimp
apply (erule JVM_CFG.cases)
apply auto
done
with Invoke state_correct kind stk_n trg_state_correct applicable sees_M
‹preallocated h›
show ?thesis
apply (cases "the (P⇘Φ⇙ C M ! pc)",
auto simp: bv_conform_def stkss_purge
simp del: find_handler_for.simps exec.simps app⇩i.simps fun_upd_apply)
apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct)
apply fastforce
apply (fastforce simp: split_beta split: if_split_asm)
apply fastforce
done
next
case [simp]: False
from a_pred Invoke
have [simp]: "m = M'"
by -(clarsimp, erule JVM_CFG.cases, auto)
from a_pred Invoke
have [simp]: "pc' = 0"
by -(clarsimp, erule JVM_CFG.cases, auto)
from ve Invoke
have [simp]: "cs' = (C,M,pc)#cs"
by -(clarsimp, erule JVM_CFG.cases, auto)
from ve Invoke kind
have [simp]:
"f = (λs. exec_instr (Invoke m n) P s (length cs) (stkLength P C M pc)
arbitrary (locLength P C' M' 0))"
by -(clarsimp, erule JVM_CFG.cases, auto)
from state_correct obtain ST LT where [simp]:
"(P⇘Φ⇙) C M ! pc = ⌊(ST,LT)⌋"
by (auto simp: bv_conform_def correct_state_def)
from a_pred Invoke
have [simp]:
"fst (method (P⇘wf⇙)
(cname_of h (the_Addr (stk (length cs, length ST - Suc n)))) M') = C'"
by -(clarsimp, erule JVM_CFG.cases, auto)
from a_pred Invoke
have [simp]: "stk (length cs, length ST - Suc n) ≠ Null"
by -(clarsimp, erule JVM_CFG.cases, auto)
from state_correct applicable sees_M Invoke
have [simp]: "ST ! n ≠ NT"
apply (auto simp: correct_state_def bv_conform_def)
apply (drule_tac p="n" and ys="ST" in list_all2_nthD)
apply simp
by clarsimp
from applicable Invoke sees_M
have "length ST > n"
by auto
with trg_state_correct Invoke
have [simp]: "stkLength P C' M' 0 = 0"
by (auto simp: split_beta correct_state_def
split: if_split_asm)
from trg_state_correct Invoke ‹length ST > n›
have "locLength P C' M' 0 =
Suc n + fst(snd(snd(snd(snd(method (P⇘wf⇙)
(cname_of h (the_Addr (stk (length cs, length ST - Suc n)))) M')))))"
by (auto simp: split_beta correct_state_def
dest!: list_all2_lengthD
split: if_split_asm)
with Invoke state_correct trg_state_correct ‹length ST > n›
have "JVMExec.exec (P⇘wf⇙, state_to_jvm_state P ((C, M, pc) # cs) s)
=
⌊(None, h,
(stks (stkLength P C' M' pc') (λa. stk (Suc (length cs), a)),
locs (locLength P C' M' pc')
(λa'. (λ(a, b).
if a = Suc (length cs) ⟶ locLength P C' M' 0 ≤ b then loc (a, b)
else if b ≤ n then stk (length cs, length ST - (Suc n - b))
else arbitrary) (Suc (length cs), a')),
C', M', pc') #
(stks (length ST) (λa. stk (length cs, a)),
locs (length LT) (λa. loc (length cs, a)), C, M, pc) #
zip (stkss P cs stk) (zip (locss P cs loc) cs))⌋"
apply (auto simp: split_beta bv_conform_def)
apply (rule nth_equalityI)
apply simp
apply (cases ST,
auto simp: nth_Cons' nth_append min.absorb1 min.absorb2)
apply (rule nth_equalityI)
apply simp
by (auto simp: rev_nth nth_Cons' nth_append min_def)
with Invoke state_correct kind trg_state_correct applicable sees_M
show ?thesis
apply (cases "the (P⇘Φ⇙ C M ! pc)",
auto simp: bv_conform_def stkss_purge rev_nth
simp del: find_handler_for.simps exec.simps app⇩i.simps)
apply(subst locss_invoke_purge, simp)
by simp
qed
qed
next
case (Load nat)
with stk_loc_succs sees_M reachable
have "stkLength P C M (Suc pc) = Suc (stkLength P C M pc)"
and "locLength P C M (Suc pc) = locLength P C M pc"
by simp_all
with state_correct ve P_wf applicable sees_M Load trg_state_correct
show ?thesis
apply auto
apply (erule JVM_CFG.cases, simp_all)
by (auto simp: bv_conform_def stkss_purge stks_purge')
next
case (Store nat)
with stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
and "locLength P C M (Suc pc) = locLength P C M pc"
by auto
with state_correct ve P_wf applicable sees_M Store trg_state_correct
show ?thesis
apply auto
apply (erule JVM_CFG.cases, simp_all)
by (auto simp: bv_conform_def locss_purge)
next
case (Push val)
with stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = Suc (stkLength P C M pc)"
and "locLength P C M (Suc pc) = locLength P C M pc"
by auto
with state_correct ve P_wf applicable sees_M Push trg_state_correct
show ?thesis
apply auto
apply (erule JVM_CFG.cases, simp_all)
by (auto simp: bv_conform_def stks_purge' stkss_purge)
next
case Pop
with stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
and "locLength P C M (Suc pc) = locLength P C M pc"
by auto
with state_correct ve P_wf applicable sees_M Pop trg_state_correct
show ?thesis
apply auto
apply (erule JVM_CFG.cases, simp_all)
by (auto simp: bv_conform_def)
next
case IAdd
with stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
and "locLength P C M (Suc pc) = locLength P C M pc"
by auto
with state_correct ve P_wf applicable sees_M IAdd trg_state_correct
show ?thesis
apply auto
apply (erule JVM_CFG.cases, simp_all)
by (auto simp: bv_conform_def stks_purge' stkss_purge add.commute)
next
case CmpEq
with stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
and "locLength P C M (Suc pc) = locLength P C M pc"
by auto
with state_correct ve P_wf applicable sees_M CmpEq trg_state_correct
show ?thesis
apply auto
apply (erule JVM_CFG.cases, simp_all)
apply (auto simp: bv_conform_def stks_purge' stkss_purge bool_sym)
apply (erule JVM_CFG.cases, simp_all)
by (auto simp: bv_conform_def stks_purge' stkss_purge bool_sym)
next
case (Goto b)
with stk_loc_succs sees_M reachable applicable
have "stkLength P C M (nat (int pc + b)) = stkLength P C M pc"
and "locLength P C M (nat (int pc + b)) = locLength P C M pc"
by auto
with state_correct ve P_wf applicable sees_M Goto trg_state_correct
show ?thesis
apply auto
by (erule JVM_CFG.cases, simp_all add: bv_conform_def)
next
case (IfFalse b)
have nat_int_pc_conv: "nat (int pc + 1) = pc + 1"
by (cases pc) auto
from IfFalse stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = stkLength P C M pc - 1"
and "stkLength P C M (nat (int pc + b)) = stkLength P C M pc - 1"
and "locLength P C M (Suc pc) = locLength P C M pc"
and "locLength P C M (nat (int pc + b)) = locLength P C M pc"
by auto
with state_correct ve P_wf applicable sees_M IfFalse pred_s nat_int_pc_conv
trg_state_correct
show ?thesis
apply auto
apply (erule JVM_CFG.cases, simp_all)
by (auto simp: bv_conform_def split: if_split_asm)
next
case Return
with ve obtain Ts' T' mxs' mxl' is' xt'
where sees_M': "(P⇘wf⇙) ⊢ C' sees M':Ts'→T' = (mxs',mxl',is',xt') in C'"
and "(pc' - 1) < length is'"
and reachable': "P⇘Φ⇙ C' M' ! (pc' - 1) ≠ None"
apply auto
apply (erule JVM_CFG.cases, auto)
by (cases cs', auto)
with Return ve wt_method sees_M applicable
have "is' ! (pc' - 1) = Invoke M (length Ts)"
apply auto
apply (erule JVM_CFG.cases, auto)
apply (drule sees_method_fun, fastforce, clarsimp)
by (auto dest!: list_all2_lengthD simp: wt_method_def wt_start_def)
from P_wf sees_M'
have "wt_method (P⇘wf⇙) C' Ts' T' mxs' mxl' is' xt' (P⇘Φ⇙ C' M')"
by (auto dest: sees_wf_mdecl simp: wf_jvm_prog_phi_def wf_mdecl_def)
with ve Return ‹pc' - 1 < length is'› reachable' sees_M state_correct
have "stkLength P C' M' pc' = stkLength P C' M' (pc' - 1) - length Ts"
using [[simproc del: list_to_set_comprehension]]
apply auto
apply (erule JVM_CFG.cases, auto)
apply (drule sees_method_fun, fastforce, clarsimp)
using sees_M'
apply hypsubst_thin
apply (auto simp: wt_method_def)
apply (erule_tac x="pc'" in allE)
apply (auto simp: bv_conform_def correct_state_def not_less_eq less_Suc_eq)
apply (drule sees_method_fun, fastforce, clarsimp)
apply (drule sees_method_fun, fastforce, clarsimp)
apply (auto simp: wt_start_def)
apply (auto dest!: list_all2_lengthD)
apply (drule sees_method_fun, fastforce, clarsimp)
apply (drule sees_method_fun, fastforce, clarsimp)
by auto
from ‹wt_method (P⇘wf⇙) C' Ts' T' mxs' mxl' is' xt' (P⇘Φ⇙ C' M')›
‹(pc' - 1) < length is'› ‹P⇘Φ⇙ C' M' ! (pc' - 1) ≠ None›
‹is' ! (pc' - 1) = Invoke M (length Ts)›
have "stkLength P C' M' (pc' - 1) > 0"
by (fastforce simp: wt_method_def)
then obtain ST' STr' where [simp]: "fst (the (P⇘Φ⇙ C' M' ! (pc' - 1))) = ST'#STr'"
by (cases "fst (the (P⇘Φ⇙ C' M' ! (pc' - 1)))", fastforce+)
from wt_method
have "locLength P C M 0 = Suc (length Ts) + mxl"
by (auto dest!: list_all2_lengthD
simp: wt_method_def wt_start_def)
from ‹wt_method (P⇘wf⇙) C' Ts' T' mxs' mxl' is' xt' (P⇘Φ⇙ C' M')›
ve Return ‹pc' - 1 < length is'› reachable' sees_M state_correct
have "locLength P C' M' (pc' - 1) = locLength P C' M' pc'"
using [[simproc del: list_to_set_comprehension]]
apply auto
apply (erule JVM_CFG.cases, auto)
apply (drule sees_method_fun, fastforce, clarsimp)
using sees_M'
apply hypsubst_thin
apply (auto simp: wt_method_def)
apply (erule_tac x="pc'" in allE)
apply (auto simp: wt_start_def)
apply (clarsimp simp: bv_conform_def correct_state_def)
apply (drule sees_method_fun, fastforce, clarsimp)
apply (drule sees_method_fun, fastforce, clarsimp)
by (auto dest!: list_all2_lengthD)
with ‹stkLength P C' M' pc' = stkLength P C' M' (pc' - 1) - length Ts›
Return state_correct ve P_wf applicable sees_M trg_state_correct sees_M'
‹fst (the (P⇘Φ⇙ C' M' ! (pc' - 1))) = ST'#STr'› ‹is' ! (pc' - 1) = Invoke M (length Ts)›
‹locLength P C M 0 = Suc (length Ts) + mxl›
show ?thesis
apply (auto simp: bv_conform_def)
apply (erule JVM_CFG.cases, auto simp: stkss_purge locss_purge)
apply (drule sees_method_fun, fastforce, clarsimp)
apply (auto simp: correct_state_def)
apply (drule sees_method_fun, fastforce, clarsimp)
apply (drule sees_method_fun, fastforce, clarsimp)
apply (drule sees_method_fun, fastforce, clarsimp)
apply (rule_tac x="Ts'" in exI)
apply (rule_tac x="T'" in exI)
apply (rule_tac x="mxs'" in exI)
apply (rule_tac x="mxl'" in exI)
apply (rule_tac x="is'" in exI)
apply clarsimp
apply (rule conjI)
apply (rule_tac x="xt'" in exI)
apply clarsimp
apply (rule list_all2_all_nthI)
apply clarsimp
apply clarsimp
apply (auto simp: rev_nth list_all2_Cons1)
apply (case_tac n, auto simp: list_all2_Cons1)
apply (case_tac n, auto simp: list_all2_Cons1)
apply (drule_tac p="nat" and ys="zs" in list_all2_nthD2)
apply clarsimp
by auto
next
case (New Cl)
from state_correct have "preallocated h"
by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
from New stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = Suc (stkLength P C M pc)"
and "locLength P C M (Suc pc) = locLength P C M pc"
by auto
with New state_correct ve sees_M trg_state_correct applicable a_pred ‹preallocated h›
show ?thesis
apply (clarsimp simp del: exec.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
defer
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (simp add: bv_conform_def stkss_purge del: exec.simps find_handler_for.simps)
apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
apply fastforce
apply fastforce
apply clarsimp
by (auto simp: split_beta bv_conform_def stks_purge' stkss_purge
simp del: find_handler_for.simps)
next
case (Getfield Fd Cl)
from state_correct have "preallocated h"
by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
from Getfield stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = stkLength P C M pc"
and "locLength P C M (Suc pc) = locLength P C M pc"
by auto
with Getfield state_correct ve sees_M trg_state_correct applicable a_pred ‹preallocated h›
show ?thesis
apply (clarsimp simp del: exec.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
defer
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (simp add: bv_conform_def stkss_purge del: exec.simps find_handler_for.simps)
apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
apply fastforce
apply (fastforce simp: split_beta)
apply clarsimp
by (auto simp: split_beta bv_conform_def stks_purge' stkss_purge
simp del: find_handler_for.simps)
next
case (Putfield Fd Cl)
from state_correct have "preallocated h"
by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
from Putfield stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = stkLength P C M pc - 2"
and "locLength P C M (Suc pc) = locLength P C M pc"
by auto
with Putfield state_correct ve sees_M trg_state_correct applicable a_pred ‹preallocated h›
show ?thesis
apply (clarsimp simp del: exec.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
defer
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (simp add: bv_conform_def stkss_purge del: exec.simps find_handler_for.simps)
apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
apply fastforce
apply (fastforce simp: split_beta)
apply clarsimp
by (auto simp: split_beta bv_conform_def stks_purge' stkss_purge
simp del: find_handler_for.simps)
next
case (Checkcast Cl)
from state_correct have "preallocated h"
by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
from Checkcast stk_loc_succs sees_M reachable applicable
have "stkLength P C M (Suc pc) = stkLength P C M pc"
and "locLength P C M (Suc pc) = locLength P C M pc"
by auto
with Checkcast state_correct ve sees_M
trg_state_correct applicable a_pred pred_s ‹preallocated h›
show ?thesis
apply (clarsimp simp del: exec.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
defer
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (simp add: bv_conform_def stkss_purge del: exec.simps find_handler_for.simps)
apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
apply fastforce
apply (fastforce simp: split_beta)
apply clarsimp
by (auto simp: split_beta bv_conform_def
simp del: find_handler_for.simps)
next
case Throw
from state_correct have "preallocated h"
by (clarsimp simp: bv_conform_def correct_state_def hconf_def)
from Throw applicable state_correct sees_M obtain a
where "stk(length cs, stkLength P C M pc - 1) = Null ∨
stk(length cs, stkLength P C M pc - 1) = Addr a"
by (cases "stk(length cs, stkLength P C M pc - 1)",
auto simp: is_refT_def bv_conform_def correct_state_def conf_def)
with Throw state_correct ve trg_state_correct a_pred applicable sees_M ‹preallocated h›
show ?thesis
apply (clarsimp simp del: exec.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp del: exec.simps find_handler_for.simps)
apply (erule JVM_CFG.cases, simp_all del: exec.simps find_handler_for.simps)
apply (clarsimp simp: bv_conform_def simp del: exec.simps find_handler_for.simps)
apply (rule conjI)
apply (clarsimp simp: stkss_purge simp del: exec.simps find_handler_for.simps)
apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
apply fastforce
apply (simp add: hd_stks)
apply simp
apply (clarsimp simp: stkss_purge simp del: exec.simps find_handler_for.simps)
apply (simp del: find_handler_for.simps exec.simps cong: if_cong)
apply (rule_tac cs="(C,M,pc)#cs" in find_handler_exec_correct [simplified])
apply fastforce
apply (simp add: hd_stks)
by simp
qed
qed
section ‹CFG simulates Jinja's semantics›
subsection ‹Definitions›
text ‹
The following predicate defines the semantics of Jinja lifted to our
state representation. Thereby, we require the state to be byte code verifier
conform; otherwise the step in the semantics is undefined.
The predicate ‹valid_callstack› is actually an implication of the
byte code verifier conformance. But we list it explicitly for convenience.
›
inductive sem :: "jvmprog ⇒ callstack ⇒ state ⇒ callstack ⇒ state ⇒ bool"
("_ ⊢ ⟨_,_⟩ ⇒ ⟨_,_⟩")
where Step:
"⟦ prog = (P,C0,Main);
P,cs ⊢⇘BV⇙ s √;
valid_callstack prog cs;
JVMExec.exec ((P⇘wf⇙), state_to_jvm_state P cs s) = ⌊(None,h',frs')⌋;
cs' = framestack_to_callstack frs';
s = (h, stk, loc);
s' = (h', update_stk stk frs', update_loc loc frs') ⟧
⟹ prog ⊢ ⟨cs,s⟩ ⇒ ⟨cs',s'⟩"
abbreviation identifies :: "j_node ⇒ callstack ⇒ bool"
where "identifies n cs ≡ (n = (_ cs,None _))"
subsection ‹Some more simplification lemmas›
lemma valid_callstack_tl:
"valid_callstack prog ((C,M,pc)#cs) ⟹ valid_callstack prog cs"
by (cases prog, cases cs, auto)
lemma stkss_cong [cong]:
"⟦ P = P';
cs = cs';
⋀a b. ⟦ a < length cs;
b < stkLength P (fst(cs ! (length cs - Suc a)))
(fst(snd(cs ! (length cs - Suc a))))
(snd(snd(cs ! (length cs - Suc a)))) ⟧
⟹ stk (a, b) = stk' (a, b) ⟧
⟹ stkss P cs stk = stkss P' cs' stk'"
by (auto, hypsubst_thin, induct cs',
auto intro!: nth_equalityI simp: nth_Cons' )
lemma locss_cong [cong]:
"⟦ P = P';
cs = cs';
⋀a b. ⟦ a < length cs;
b < locLength P (fst(cs ! (length cs - Suc a)))
(fst(snd(cs ! (length cs - Suc a))))
(snd(snd(cs ! (length cs - Suc a)))) ⟧
⟹ loc (a, b) = loc' (a, b) ⟧
⟹ locss P cs loc = locss P' cs' loc'"
by (auto, hypsubst_thin, induct cs',
auto intro!: nth_equalityI simp: nth_Cons' )
lemma hd_tl_equalityI:
"⟦ length xs = length ys; hd xs = hd ys; tl xs = tl ys ⟧ ⟹ xs = ys"
apply (induct xs arbitrary: ys)
apply simp
by (case_tac ys, auto)
lemma stkLength_is_length_stk:
"P⇘wf⇙,P⇘Φ⇙ ⊢ (None, h, (stk, loc, C, M, pc) # frs') √ ⟹ stkLength P C M pc = length stk"
by (auto dest!: list_all2_lengthD simp: correct_state_def)
lemma locLength_is_length_loc:
"P⇘wf⇙,P⇘Φ⇙ ⊢ (None, h, (stk, loc, C, M, pc) # frs') √ ⟹ locLength P C M pc = length loc"
by (auto dest!: list_all2_lengthD simp: correct_state_def)
lemma correct_state_frs_tlD:
"(P⇘wf⇙),(P⇘Φ⇙) ⊢ (None, h, a # frs') √ ⟹ (P⇘wf⇙),(P⇘Φ⇙) ⊢ (None, h, frs') √"
by (cases frs', (fastforce simp: correct_state_def)+)
lemma update_stk_Cons [simp]:
"stkss P (framestack_to_callstack frs') (update_stk stk ((stk', loc', C', M', pc') # frs')) =
stkss P (framestack_to_callstack frs') (update_stk stk frs')"
apply (induct frs' arbitrary: stk' loc' C' M' pc')
apply clarsimp
apply (simp only: f2c_Nil)
apply clarsimp
apply clarsimp
apply (simp only: f2c_Cons)
apply clarsimp
apply (rule stkss_cong)
by (fastforce simp: nth_Cons')+
lemma update_loc_Cons [simp]:
"locss P (framestack_to_callstack frs') (update_loc loc ((stk', loc', C', M', pc') # frs')) =
locss P (framestack_to_callstack frs') (update_loc loc frs')"
apply (induct frs' arbitrary: stk' loc' C' M' pc')
apply clarsimp
apply (simp only: f2c_Nil)
apply clarsimp
apply clarsimp
apply (simp only: f2c_Cons)
apply clarsimp
apply (rule locss_cong)
by (fastforce simp: nth_Cons')+
lemma s2j_id:
"(P⇘wf⇙),(P⇘Φ⇙) ⊢ (None,h',frs') √
⟹ state_to_jvm_state P (framestack_to_callstack frs')
(h, update_stk stk frs', update_loc loc frs') = (None, h, frs')"
apply (induct frs')
apply simp
apply simp
apply (rule hd_tl_equalityI)
apply simp
apply simp
apply clarsimp
apply (simp only: f2c_Cons fst_conv snd_conv)
apply clarsimp
apply (rule conjI)
apply (rule nth_equalityI)
apply (simp add: stkLength_is_length_stk)
apply (clarsimp simp: stkLength_is_length_stk)
apply (case_tac a, simp_all)
apply (rule nth_equalityI)
apply (simp add: locLength_is_length_loc)
apply (clarsimp simp: locLength_is_length_loc)
apply (drule correct_state_frs_tlD)
apply simp
apply clarsimp
apply (simp only: f2c_Cons fst_conv snd_conv)
by clarsimp
lemma find_handler_last_cs_eqD:
"⟦ find_handler P⇘wf⇙ a h frs = (None, h', frs');
last frs = (stk,loc,C,M,pc);
last frs' = (stk',loc',C',M',pc') ⟧
⟹ C = C' ∧ M = M'"
by (induct frs, auto split: if_split_asm)
lemma exec_last_frs_eq_class:
"⟦ JVMExec.exec (P⇘wf⇙, None, h, frs) = ⌊(None, h', frs')⌋;
last frs = (stk, loc, C, M, pc);
last frs' = (stk', loc', C', M', pc');
frs ≠ [];
frs' ≠ [] ⟧
⟹ C = C'"
apply (cases frs, auto split: if_split_asm)
apply (cases "instrs_of P⇘wf⇙ C M ! pc", auto simp: split_beta)
apply (case_tac "instrs_of P⇘wf⇙ ab ac ! b", auto simp: split_beta)
apply (case_tac list, auto)
apply (case_tac lista, auto)
apply (drule find_handler_last_cs_eqD)
apply fastforce
apply fastforce
by simp
lemma exec_last_frs_eq_method:
"⟦ JVMExec.exec (P⇘wf⇙, None, h, frs) = ⌊(None, h', frs')⌋;
last frs = (stk, loc, C, M, pc);
last frs' = (stk', loc', C', M', pc');
frs ≠ [];
frs' ≠ [] ⟧
⟹ M = M'"
apply (cases frs, auto split: if_split_asm)
apply (cases "instrs_of P⇘wf⇙ C M ! pc", auto simp: split_beta)
apply (case_tac "instrs_of P⇘wf⇙ ab ac ! b", auto simp: split_beta)
apply (case_tac list, auto)
apply (case_tac lista, auto)
apply (drule find_handler_last_cs_eqD)
apply fastforce
apply fastforce
by simp
lemma valid_callstack_append_last_class:
"valid_callstack (P,C0,Main) (cs@[(C,M,pc)]) ⟹ C = C0"
by (induct cs, auto dest: valid_callstack_tl)
lemma valid_callstack_append_last_method:
"valid_callstack (P,C0,Main) (cs@[(C,M,pc)]) ⟹ M = Main"
by (induct cs, auto dest: valid_callstack_tl)
lemma zip_stkss_locss_append_single [simp]:
"zip (stkss P (cs @ [(C, M, pc)]) stk)
(zip (locss P (cs @ [(C, M, pc)]) loc) (cs @ [(C, M, pc)]))
= (zip (stkss P (cs @ [(C, M, pc)]) stk) (zip (locss P (cs @ [(C, M, pc)]) loc) cs))
@ [(stks (stkLength P C M pc) (λa. stk (0, a)),
locs (locLength P C M pc) (λa. loc (0, a)), C, M, pc)]"
by (induct cs, auto)
subsection ‹Interpretation of the ‹CFG_semantics_wf› locale›
interpretation JVM_semantics_CFG_wf:
CFG_semantics_wf "sourcenode" "targetnode" "kind" "valid_edge prog" "(_Entry_)"
"sem prog" "identifies"
for prog
proof(unfold_locales)
fix n c s c' s'
assume sem_step:"prog ⊢ ⟨c,s⟩ ⇒ ⟨c',s'⟩"
and "identifies n c"
obtain P C0 M0
where prog [simp]:"prog = (P,C0,M0)"
by (cases prog,fastforce)
obtain h stk loc
where s [simp]: "s = (h,stk,loc)"
by (cases s, fastforce)
obtain h' stk' loc'
where s' [simp]: "s' = (h',stk',loc')"
by (cases s', fastforce)
from sem_step s s' prog obtain C M pc cs C' M' pc' cs'
where c [simp]: "c = (C,M,pc)#cs"
by (cases c, auto elim: sem.cases simp: bv_conform_def)
with sem_step prog obtain ST LT
where wt [simp]: " (P⇘Φ⇙) C M ! pc = ⌊(ST,LT)⌋"
by (auto elim!: sem.cases, cases cs, fastforce+)
note P_wf = wf_jvmprog_is_wf [of P]
from sem_step prog obtain frs'
where jvm_exec: "JVMExec.exec ((P⇘wf⇙), state_to_jvm_state P c s) = ⌊(None,h',frs')⌋"
by (auto elim!: sem.cases)
with sem_step prog s s'
have loc': "loc' = update_loc loc frs'"
and stk': "stk' = update_stk stk frs'"
by (auto elim!: sem.cases)
from sem_step s prog
have state_wf: "P,c ⊢⇘BV⇙ (h,stk,loc) √"
by (auto elim!: sem.cases)
hence state_correct: "(P⇘wf⇙),(P⇘Φ⇙) ⊢ state_to_jvm_state P c (h,stk,loc) √"
by (simp add: bv_conform_def)
with P_wf jvm_exec s
have trg_state_correct: "(P⇘wf⇙),(P⇘Φ⇙) ⊢ (None,h',frs') √"
by -(rule BV_correct_1, (fastforce simp: exec_1_iff)+)
from sem_step c s prog have prealloc: "preallocated h"
by (auto elim: sem.cases
simp: bv_conform_def correct_state_def hconf_def)
from state_correct obtain Ts T mxs mxl "is" xt
where sees_M: "(P⇘wf⇙) ⊢ C sees M:Ts→T = (mxs,mxl,is,xt) in C"
by (clarsimp simp: bv_conform_def correct_state_def)
with state_correct
have "pc < length is"
by (auto dest: sees_method_fun
simp: bv_conform_def correct_state_def)
with P_wf sees_M have
applicable: "app⇩i(is ! pc, (P⇘wf⇙), pc, mxs, T, ST, LT)"
by (fastforce dest!: sees_wf_mdecl
simp: wf_jvm_prog_phi_def wf_mdecl_def wt_method_def)
from sem_step
have v_cs: "valid_callstack prog c"
by (auto elim: sem.cases)
then obtain pcL where last_c: "last c = (C0,M0,pcL)"
apply clarsimp
apply (induct cs arbitrary: C M pc, simp)
by fastforce
from sees_M P_wf ‹pc < length is›
have wt_instrs: "P⇘wf⇙,T,mxs,length is,xt ⊢ is ! pc,pc :: (P⇘Φ⇙) C M"
by -(drule wt_jvm_prog_impl_wt_instr, fastforce+)
with applicable
have effect: "∀succ ∈ set (succs (is ! pc) (ST,LT) pc).
(P⇘wf⇙) ⊢ ⌊eff⇩i(is ! pc, (P⇘wf⇙), ST, LT)⌋ ≤' (P⇘Φ⇙) C M ! succ ∧ succ < length is"
apply clarsimp
apply (erule_tac x="(succ, ⌊eff⇩i(is ! pc, (P⇘wf⇙), ST, LT)⌋ )" in ballE)
by (erule_tac x="(succ, ⌊eff⇩i(is ! pc, (P⇘wf⇙), ST, LT)⌋ )" in ballE, clarsimp+)
with P_wf sees_M last_c v_cs
have v_cs_succ:
"∀succ ∈ set (succs (is ! pc) (ST,LT) pc). valid_callstack (P,C0,M0) ((C,M,succ)#cs)"
by -(rule ballI,
erule_tac x="succ" in ballE,
auto,
induct cs,
fastforce+)
from trg_state_correct v_cs jvm_exec
have v_cs_f2c_frs':
"valid_callstack (P,C0,M0) (framestack_to_callstack frs')"
apply (cases frs' rule: rev_cases, simp)
apply (rule_tac s="(h', update_stk stk frs', update_loc loc frs')"
in correct_state_imp_valid_callstack)
apply (simp only: bv_conform_def s2j_id)
apply (auto dest!: f2c_emptyD simp del: exec.simps)
apply (cases cs rule: rev_cases)
apply (clarsimp simp del: exec.simps)
apply (drule exec_last_frs_eq_class, fastforce+)
apply (clarsimp simp del: exec.simps)
apply (simp only: append_Cons [symmetric])
apply (frule valid_callstack_append_last_class)
apply (frule valid_callstack_append_last_method)
apply (clarsimp simp del: exec.simps)
apply (drule exec_last_frs_eq_class, fastforce+)
apply (cases cs rule: rev_cases)
apply (clarsimp simp del: exec.simps)
apply (drule exec_last_frs_eq_method, fastforce+)
apply (clarsimp simp del: exec.simps)
apply (simp only: append_Cons [symmetric])
apply (frule valid_callstack_append_last_method)
apply (clarsimp simp del: exec.simps)
by (drule exec_last_frs_eq_method, fastforce+)
show "∃n' as.
CFG.path sourcenode targetnode (valid_edge prog) n as n' ∧
transfers (CFG.kinds kind as) s = s' ∧
preds (CFG.kinds kind as) s ∧ identifies n' c'"
proof
show "∃as. CFG.path sourcenode targetnode (valid_edge prog) n as (_ c',None _) ∧
transfers (CFG.kinds kind as) s = s' ∧
preds (CFG.kinds kind as) s ∧
identifies (_ c',None _) c'"
proof (cases "(instrs_of (P⇘wf⇙) C M)!pc")
case (Load nat)
with sem_step s s' c prog
have c': "c' = (C,M,pc+1)#cs"
by (auto elim!: sem.cases)
from applicable sees_M Load
have "nat < length LT"
by simp
from sees_M Load have "Suc pc ∈ set (succs (is ! pc) (ST,LT) pc)"
by simp
with prog sem_step Load v_cs_succ
have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
⇑(λs. exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e1")
by (auto elim!: sem.cases intro: JCFG_Straight_NoExc)
with ‹identifies n c› c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Load jvm_exec loc' stk' c c' s s' prog wt ‹nat < length LT›
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto intro!: ext
simp: JVM_CFG_Interpret.kinds_def
nth_stkss nth_locss nth_Cons' nth_tl
not_less_eq_eq Suc_le_eq)
moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case (Store nat)
with sem_step s s' c prog
have c': "c' = (C,M,pc+1)#cs"
by (auto elim!: sem.cases)
from applicable Store sees_M
have "length ST > 0 ∧ nat < length LT"
by clarsimp
then obtain ST1 STr where [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
from sees_M Store have "Suc pc ∈ set (succs (is ! pc) (ST, LT) pc)"
by simp
with prog sem_step Store v_cs_succ
have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
⇑(λs. exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e1")
by (fastforce elim: sem.cases intro: JCFG_Straight_NoExc)
with ‹identifies n c› c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Store jvm_exec stk' loc' c c' s s' prog wt
‹length ST > 0 ∧ nat < length LT›
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto intro!: ext
simp: JVM_CFG_Interpret.kinds_def
nth_stkss nth_locss nth_Cons' nth_tl
not_less_eq_eq hd_stks)
moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case (Push val)
with sem_step s s' c prog
have c': "c' = (C,M,pc+1)#cs"
by (auto elim!: sem.cases)
from sees_M Push have "Suc pc ∈ set (succs (is ! pc) (ST, LT) pc)"
by simp
with prog sem_step Push v_cs_succ
have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
⇑(λs. exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e1")
by (fastforce elim: sem.cases intro: JCFG_Straight_NoExc)
with ‹identifies n c› c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Push jvm_exec stk' loc' c c' s s' prog wt
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto intro!: ext
simp: JVM_CFG_Interpret.kinds_def
nth_stkss nth_locss nth_Cons' nth_tl
not_less_eq_eq)
moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case (New Cl)
show ?thesis
proof (cases "new_Addr h")
case None
with New sem_step s s' c prog prealloc
have c': "c' = find_handler_for P OutOfMemory c"
by (fastforce elim!: sem.cases
dest: find_handler_find_handler_forD)
with jvm_exec New None prealloc
have f2c_frs'_c': "framestack_to_callstack frs' = c'"
by (auto dest!: find_handler_find_handler_forD)
with New c' v_cs v_cs_f2c_frs'
have v_pred_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). new_Addr h = None)⇩√,
(_ (C,M,pc)#cs,⌊(c',True)⌋ _))"
(is "valid_edge prog ?e1")
apply auto
apply (rule JCFG_New_Exc_Pred, fastforce+)
apply (rule_tac x="(λ(h, stk, loc). new_Addr h = None)" in exI)
apply (rule JCFG_New_Exc_Pred, fastforce+)
apply (cases "find_handler_for P OutOfMemory cs")
apply (rule exI)
apply clarsimp
apply (rule JCFG_New_Exc_Exit, fastforce+)
apply clarsimp
apply (rule_tac x="λ(h, stk, loc).
(h, stk((length list, stkLength P a aa b - Suc 0) :=
Addr (addr_of_sys_xcpt OutOfMemory)),
loc)" in exI)
apply (rule JCFG_New_Exc_Update, fastforce+)
apply (rule JCFG_New_Exc_Pred, fastforce+)
apply (rule exI)
apply (rule JCFG_New_Exc_Pred, fastforce+)
apply (rule exI)
by (rule JCFG_New_Exc_Update, fastforce+)
show ?thesis
proof (cases c')
case Nil
with prog sem_step New c
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊([],True)⌋ _),
⇑id,
(_Exit_))"
(is "valid_edge prog ?e2")
by (fastforce elim: sem.cases intro: JCFG_New_Exc_Exit)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_Exit_)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Nil None New sem_step c c' s s' prog
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto elim!: sem.cases simp: JVM_CFG_Interpret.kinds_def)
moreover from None s have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis using Nil by fastforce
next
case (Cons a cs')
then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
from jvm_exec c s None New
have "update_loc loc frs' = loc"
by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc], simp)
with loc' have "loc' = loc"
by simp
from c Cons s s' sem_step jvm_exec prog
have "(C',M',pc')#cs' = framestack_to_callstack frs'"
by (auto elim!: sem.cases)
moreover obtain stk'' loc'' frs'' where frs': "frs' = (stk'',loc'',C',M',pc')#frs''"
and cs': "cs' = framestack_to_callstack frs''" using calculation
by (cases frs', fastforce+)
ultimately
have "update_stk stk frs' =
stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt OutOfMemory))"
using c s c' None Cons prog New trg_state_correct wt jvm_exec prealloc stk'
by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
auto dest!: list_all2_lengthD
simp: hd_stks split_beta framestack_to_callstack_def
correct_state_def)
with stk' have stk':
"stk' =
stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt OutOfMemory))"
by simp
from New Cons v_cs_f2c_frs' v_cs f2c_frs'_c'
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',True)⌋ _),
⇑(λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) :=
Addr (addr_of_sys_xcpt OutOfMemory)),
loc)
),
(_ c',None _))"
(is "valid_edge prog ?e2")
apply auto
apply (rule JCFG_New_Exc_Update)
apply fastforce
apply fastforce
using Cons c' apply simp
apply simp
using v_pred_edge c' Cons apply clarsimp
using v_pred_edge c' Cons apply clarsimp
done
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
moreover from New c c' s s' loc' stk' ‹loc' = loc› prog jvm_exec None
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto dest: find_handler_heap_eqD
simp: JVM_CFG_Interpret.kinds_def)
moreover from None s
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case (Some obj)
with New sem_step s s' c prog prealloc
have c': "c' = (C,M,Suc pc)#cs"
by (auto elim!: sem.cases)
with New jvm_exec Some
have f2c_frs'_c': "framestack_to_callstack frs' = c'"
by auto
with New c' v_cs v_cs_f2c_frs'
have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). new_Addr h ≠ None)⇩√,
(_ (C,M,pc)#cs,⌊(c',False)⌋ _))"
(is "valid_edge prog ?e1")
apply auto
apply (fastforce intro!: JCFG_New_Normal_Pred)
apply (rule exI)
apply (fastforce intro!: JCFG_New_Normal_Pred)
apply (rule exI)
by (fastforce intro!: JCFG_New_Normal_Update)
from New sees_M have "Suc pc ∈ set (succs (is ! pc) (ST, LT) pc)"
by simp
with prog New c' sem_step prog v_cs_succ
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',False)⌋ _),
⇑(λs. exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e2")
by (auto elim!: sem.cases intro: JCFG_New_Normal_Update JCFG_New_Normal_Pred)
with v_pred_edge ‹identifies n c› c c'
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from New jvm_exec loc' stk' c c' s s' prog Some
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto intro!: ext
simp: JVM_CFG_Interpret.kinds_def
nth_stkss nth_locss nth_Cons'
not_less_eq_eq hd_stks)
moreover from Some s
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case (Getfield Fd Cl)
with applicable sees_M
have "length ST > 0"
by clarsimp
then obtain ST1 STr where ST [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
show ?thesis
proof (cases "stk(length cs, stkLength P C M pc - 1) = Null")
case True
with Getfield sem_step s s' c prog prealloc wt
have c': "c' = find_handler_for P NullPointer c"
by (cases "the (h (the_Addr Null))",
auto elim!: sem.cases
dest!: find_handler_find_handler_forD
simp: hd_stks)
with Getfield True jvm_exec prealloc
have "framestack_to_callstack frs' = c'"
by (auto simp: split_beta dest!: find_handler_find_handler_forD)
with Getfield prog c' v_cs v_cs_f2c_frs'
have v_pred_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1) = Null)⇩√,
(_ (C,M,pc)#cs,⌊(c',True)⌋ _))"
(is "valid_edge prog ?e1")
apply (auto simp del: find_handler_for.simps)
apply (fastforce intro!: JCFG_Getfield_Exc_Pred)
apply (fastforce intro!: JCFG_Getfield_Exc_Pred)
apply auto
apply (cases "find_handler_for P NullPointer cs")
apply (fastforce intro!: JCFG_Getfield_Exc_Exit)
apply (fastforce intro!: JCFG_Getfield_Exc_Update)
apply (fastforce intro!: JCFG_Getfield_Exc_Update)
done
show ?thesis
proof (cases c')
case Nil
with Getfield c prog c' v_pred_edge
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊([],True)⌋ _),
⇑id,
(_Exit_))"
(is "valid_edge prog ?e2")
by (fastforce intro: JCFG_Getfield_Exc_Exit)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_Exit_)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Nil True Getfield sem_step c c' s s' prog wt ‹length ST > 0›
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto elim!: sem.cases
simp: hd_stks split_beta JVM_CFG_Interpret.kinds_def)
moreover from True s
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis using Nil by fastforce
next
case (Cons a cs')
then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
from jvm_exec c s True Getfield wt ST
have "update_loc loc frs' = loc"
by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc],
auto simp: split_beta hd_stks)
with loc' have "loc' = loc"
by simp
from c Cons s s' sem_step jvm_exec prog
have cs'_f2c_frs': "(C',M',pc')#cs' = framestack_to_callstack frs'"
by (auto elim!: sem.cases)
moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
and "cs' = framestack_to_callstack frs''" using calculation
by (cases frs', fastforce+)
ultimately
have "update_stk stk frs' =
stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
using c s c' True Cons prog Getfield trg_state_correct wt ST jvm_exec prealloc stk'
by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
auto dest!: list_all2_lengthD
simp: hd_stks split_beta framestack_to_callstack_def
correct_state_def)
with stk' have stk':
"stk' =
stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
by simp
from prog Cons Getfield c' v_cs v_cs_f2c_frs' jvm_exec
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',True)⌋ _),
⇑(λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) :=
Addr (addr_of_sys_xcpt NullPointer)),
loc)
),
(_ c',None _))"
(is "valid_edge prog ?e2")
apply (auto simp del: exec.simps find_handler_for.simps)
apply (rule JCFG_Getfield_Exc_Update, fastforce+)
apply (simp only: cs'_f2c_frs')
apply (fastforce intro!: JCFG_Getfield_Exc_Pred)
apply (fastforce intro!: JCFG_Getfield_Exc_Update)
by (simp only: cs'_f2c_frs')
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
moreover from Getfield c c' s s' loc' stk' prog True jvm_exec
‹loc' = loc› wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto dest: find_handler_heap_eqD
simp: JVM_CFG_Interpret.kinds_def split_beta hd_stks)
moreover from True s
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case False
with Getfield sem_step s s' c prog prealloc wt ‹length ST > 0›
have c': "c' = (C,M,Suc pc)#cs"
by (auto elim!: sem.cases
simp: split_beta hd_stks)
with False Getfield jvm_exec prealloc
have "framestack_to_callstack frs' = c'"
by (auto dest!: find_handler_find_handler_forD simp: split_beta)
with Getfield c' v_cs v_cs_f2c_frs'
have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). stk(length cs, stkLength P C M pc - 1) ≠ Null)⇩√,
(_ (C,M,pc)#cs,⌊(c',False)⌋ _))"
(is "valid_edge prog ?e1")
apply auto
apply (fastforce intro: JCFG_Getfield_Normal_Pred)
apply (fastforce intro: JCFG_Getfield_Normal_Pred)
by (fastforce intro: JCFG_Getfield_Normal_Update)
with prog c' Getfield v_cs_succ sees_M
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',False)⌋ _),
⇑(λs. exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e2")
by (fastforce intro: JCFG_Getfield_Normal_Update)
with v_pred_edge ‹identifies n c› c c'
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Getfield jvm_exec stk' loc' c c' s s' prog False wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto intro!: ext
simp: nth_stkss nth_locss nth_tl nth_Cons' hd_stks
not_less_eq_eq split_beta JVM_CFG_Interpret.kinds_def)
moreover from False s
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case (Putfield Fd Cl)
with applicable sees_M
have "length ST > 1"
by clarsimp
then obtain ST1 STr' where "ST = ST1#STr'"
by (cases ST, fastforce+)
with ‹length ST > 1› obtain ST2 STr
where ST: "ST = ST1#ST2#STr"
by (cases STr', fastforce+)
show ?thesis
proof (cases "stk(length cs, stkLength P C M pc - 2) = Null")
case True
with Putfield sem_step s s' c prog prealloc wt ‹length ST > 1›
have c': "c' = find_handler_for P NullPointer c"
by (auto elim!: sem.cases
dest!: find_handler_find_handler_forD
simp: hd_tl_stks split_beta)
with Putfield jvm_exec True prealloc ‹length ST > 1› wt
have "framestack_to_callstack frs' = c'"
by (auto dest!: find_handler_find_handler_forD simp: split_beta hd_tl_stks)
with Putfield c' v_cs v_cs_f2c_frs'
have v_pred_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). stk(length cs, stkLength P C M pc - 2) = Null)⇩√,
(_ (C,M,pc)#cs,⌊(c',True)⌋ _))"
(is "valid_edge prog ?e1")
apply (auto simp del: find_handler_for.simps)
apply (fastforce intro: JCFG_Putfield_Exc_Pred)
apply (fastforce intro: JCFG_Putfield_Exc_Pred)
apply (cases "find_handler_for P NullPointer ((C, M, pc)#cs)")
apply (fastforce intro: JCFG_Putfield_Exc_Exit)
by (fastforce intro: JCFG_Putfield_Exc_Update)
show ?thesis
proof (cases c')
case Nil
with Putfield c prog c' v_pred_edge
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊([],True)⌋ _),
⇑id,
(_Exit_))"
(is "valid_edge prog ?e2")
by (fastforce intro: JCFG_Putfield_Exc_Exit)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_Exit_)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Nil True Putfield sem_step c c' s s' prog wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto elim!: sem.cases
simp: split_beta JVM_CFG_Interpret.kinds_def)
moreover from True s
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis using Nil by fastforce
next
case (Cons a cs')
then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
from jvm_exec c s True Putfield ST wt
have "update_loc loc frs' = loc"
by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc],
auto simp: split_beta hd_tl_stks if_split_eq1)
with sem_step s s' c prog jvm_exec
have loc':"loc' = loc"
by (clarsimp elim!: sem.cases)
from c Cons s s' sem_step jvm_exec prog
have "stk' = update_stk stk frs'"
and cs'_f2c_frs': "(C',M',pc')#cs' = framestack_to_callstack frs'"
by (auto elim!: sem.cases)
moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
and "cs' = framestack_to_callstack frs''" using calculation
by (cases frs', fastforce+)
ultimately
have stk':
"update_stk stk frs' =
stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
using c s Cons True prog Putfield ST wt trg_state_correct jvm_exec
by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
auto dest!: list_all2_lengthD
simp: hd_stks hd_tl_stks split_beta framestack_to_callstack_def
correct_state_def)
from Cons Putfield c prog c' v_pred_edge v_cs_f2c_frs' jvm_exec
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',True)⌋ _),
⇑(λ(h,stk,loc).
(h, stk((length cs',(stkLength P C' M' pc') - 1) :=
Addr (addr_of_sys_xcpt NullPointer)), loc) ),
(_ c',None _))"
(is "valid_edge prog ?e2")
by (auto intro!: JCFG_Putfield_Exc_Update)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
moreover from True Putfield c c' s s' loc' stk' ‹stk' = update_stk stk frs'›
jvm_exec wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto dest: find_handler_heap_eqD
simp: JVM_CFG_Interpret.kinds_def hd_tl_stks split_beta)
moreover from True s
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case False
with Putfield sem_step s s' c prog prealloc wt ‹length ST > 1›
have c': "c' = (C,M,Suc pc)#cs"
by (auto elim!: sem.cases
simp: hd_tl_stks split_beta)
with Putfield False jvm_exec ‹length ST > 1› wt
have "framestack_to_callstack frs' = c'"
by (auto simp: split_beta hd_tl_stks)
with Putfield c' v_cs v_cs_f2c_frs'
have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). stk(length cs, stkLength P C M pc - 2) ≠ Null)⇩√,
(_ (C,M,pc)#cs,⌊(c',False)⌋ _))"
(is "valid_edge prog ?e1")
apply auto
apply (fastforce intro: JCFG_Putfield_Normal_Pred)
apply (fastforce intro: JCFG_Putfield_Normal_Pred)
by (fastforce intro: JCFG_Putfield_Normal_Update)
with prog Putfield c' v_cs_succ sees_M
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',False)⌋ _),
⇑(λs. exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e2")
by (fastforce intro: JCFG_Putfield_Normal_Update)
with v_pred_edge ‹identifies n c› c c'
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Putfield jvm_exec stk' loc' c c' s s' prog False wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto intro!: ext
simp: JVM_CFG_Interpret.kinds_def split_beta
nth_stkss nth_locss nth_Cons'
not_less_eq_eq)
moreover from False s
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case (Checkcast Cl)
with applicable sees_M
have "length ST > 0"
by clarsimp
then obtain ST1 STr where ST: "ST = ST1#STr" by (cases ST, fastforce+)
show ?thesis
proof (cases "¬ cast_ok (P⇘wf⇙) Cl h (stk(length cs,length ST - Suc 0))")
case True
with Checkcast sem_step s s' c prog prealloc wt ‹length ST > 0›
have c': "c' = find_handler_for P ClassCast c"
by (auto elim!: sem.cases
dest!: find_handler_find_handler_forD
simp: hd_stks split_beta)
with jvm_exec Checkcast True prealloc ‹length ST > 0› wt
have "framestack_to_callstack frs' = c'"
by (auto dest!: find_handler_find_handler_forD simp: hd_stks)
with Checkcast c' v_cs v_cs_f2c_frs'
have v_pred_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). ¬ cast_ok (P⇘wf⇙) Cl h (stk(length cs, stkLength P C M pc - Suc 0)))⇩√,
(_ (C,M,pc)#cs,⌊(c',True)⌋ _))"
(is "valid_edge prog ?e1")
apply (auto simp del: find_handler_for.simps)
apply (fastforce intro: JCFG_Checkcast_Exc_Pred)
apply (fastforce intro: JCFG_Checkcast_Exc_Pred)
apply (cases "find_handler_for P ClassCast ((C,M,pc)#cs)")
apply (fastforce intro: JCFG_Checkcast_Exc_Exit)
by (fastforce intro: JCFG_Checkcast_Exc_Update)
show ?thesis
proof (cases c')
case Nil
with Checkcast c prog c' v_pred_edge
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊([],True)⌋ _),
⇑id,
(_Exit_))"
(is "valid_edge prog ?e2")
by (fastforce intro: JCFG_Checkcast_Exc_Exit)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_Exit_)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Nil True Checkcast sem_step c c' s s' prog wt ‹length ST > 0›
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto elim!: sem.cases
simp: hd_stks split_beta JVM_CFG_Interpret.kinds_def)
moreover from True s wt
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis using Nil by fastforce
next
case (Cons a cs')
then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
from jvm_exec c s True Checkcast ST wt
have loc'': "update_loc loc frs' = loc"
by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc],
auto simp: split_beta hd_tl_stks if_split_eq1)
from c Cons s s' sem_step jvm_exec prog
have "stk' = update_stk stk frs'"
and [simp]: "framestack_to_callstack frs' = (C', M', pc')#cs'"
by (auto elim!: sem.cases)
moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
and "cs' = framestack_to_callstack frs''" using calculation
by (cases frs', fastforce+)
ultimately
have stk'':
"update_stk stk frs' =
stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt ClassCast))"
using c s Cons True prog Checkcast ST wt trg_state_correct jvm_exec
by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
auto dest!: list_all2_lengthD
simp: hd_stks hd_tl_stks split_beta framestack_to_callstack_def
correct_state_def)
from prog Checkcast Cons c c' v_pred_edge v_cs_f2c_frs'
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',True)⌋ _),
⇑(λ(h,stk,loc).
(h,
stk((length cs',(stkLength P C' M' pc') - 1) :=
Addr (addr_of_sys_xcpt ClassCast)),
loc)
),
(_ c',None _))"
(is "valid_edge prog ?e2")
by (auto intro!: JCFG_Checkcast_Exc_Update)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
moreover from True Checkcast c s s' loc' stk' loc'' stk''
prog wt ST jvm_exec
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto dest: find_handler_heap_eqD
simp: JVM_CFG_Interpret.kinds_def split_beta)
moreover from True s wt
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case False
with Checkcast sem_step s s' c prog prealloc wt ‹length ST > 0›
have c': "c' = (C,M,Suc pc)#cs"
by (auto elim!: sem.cases
simp: hd_stks split_beta)
with prog Checkcast sem_step c s v_cs_succ sees_M
have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). cast_ok (P⇘wf⇙) Cl h (stk(length cs, stkLength P C M pc - Suc 0)))⇩√,
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e1")
by (auto intro!: JCFG_Checkcast_Normal_Pred elim: sem.cases)
with ‹identifies n c› c c'
have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Checkcast jvm_exec stk' loc' c s s' prog False wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto elim!: sem.cases
intro!: ext
simp: split_beta hd_stks JVM_CFG_Interpret.kinds_def
nth_stkss nth_locss nth_Cons'
not_less_eq_eq)
moreover from False s wt
have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case (Invoke M' n')
with applicable sees_M
have "length ST > n'"
by clarsimp
moreover obtain STn where "STn = take n' ST" by fastforce
moreover obtain STs where "STs = ST ! n'" by fastforce
moreover obtain STr where "STr = drop (Suc n') ST" by fastforce
ultimately have ST:" ST = STn@STs#STr ∧ length STn = n'"
by (auto simp: id_take_nth_drop)
with jvm_exec c s Invoke wt
have "h = h'"
by (auto dest: find_handler_heap_eqD
simp: split_beta nth_Cons' if_split_eq1)
show ?thesis
proof (cases "stk(length cs, stkLength P C M pc - Suc n') = Null")
case True
with Invoke sem_step prog prealloc wt ST
have c': "c' = find_handler_for P NullPointer c"
apply (auto elim!: sem.cases
simp: split_beta nth_Cons' ST
split: if_split_asm)
by (auto dest!: find_handler_find_handler_forD)
with jvm_exec True Invoke wt ST prealloc
have "framestack_to_callstack frs' = c'"
by (auto dest!: find_handler_find_handler_forD
simp: split_beta nth_Cons' if_split_eq1)
with Invoke c' v_cs v_cs_f2c_frs'
have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). stk(length cs, stkLength P C M pc - Suc n') = Null )⇩√,
(_ (C,M,pc)#cs,⌊(c',True)⌋ _))"
(is "valid_edge prog ?e1")
apply (auto simp del: find_handler_for.simps)
apply (fastforce intro: JCFG_Invoke_Exc_Pred)
apply (fastforce intro: JCFG_Invoke_Exc_Pred)
apply (cases "find_handler_for P NullPointer ((C, M, pc) # cs)")
apply (fastforce intro: JCFG_Invoke_Exc_Exit)
by (fastforce intro: JCFG_Invoke_Exc_Update)
show ?thesis
proof (cases c')
case Nil
with prog Invoke c c' v_pred_edge
have v_exec_edge: "valid_edge prog ((_ (C,M,pc)#cs,⌊([],True)⌋ _),
⇑id,
(_Exit_))"
(is "valid_edge prog ?e2")
by (fastforce intro: JCFG_Invoke_Exc_Exit)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Invoke jvm_exec stk' loc' c c' s s'
prog True wt ST prealloc Nil ‹h = h'›
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto dest!: find_handler_find_handler_forD
simp: split_beta JVM_CFG_Interpret.kinds_def
nth_Cons' if_split_eq1 framestack_to_callstack_def)
moreover from s True
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case (Cons a cs')
then obtain C' M' pc' where Cons: "c' = (C',M',pc')#cs'"
by (cases a, fastforce)
from jvm_exec c s True Invoke ST wt
have loc'': "update_loc loc frs' = loc"
by -(rule find_handler_loc_fun_eq' [of P _ h "(C,M,pc)#cs" stk loc],
auto simp: split_beta if_split_eq1 nth_Cons' )
from c Cons s s' sem_step jvm_exec prog
have "stk' = update_stk stk frs'"
and [simp]: "framestack_to_callstack frs' = (C',M',pc')#cs'"
by (auto elim!: sem.cases)
moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
and "cs' = framestack_to_callstack frs''" using calculation
by (cases frs', fastforce+)
ultimately
have stk'':
"update_stk stk frs' =
stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
using c s Cons True prog Invoke ST wt trg_state_correct jvm_exec
by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
auto dest!: list_all2_lengthD
simp: nth_Cons' split_beta correct_state_def if_split_eq1)
from Cons Invoke c prog c' v_pred_edge v_cs_f2c_frs'
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',True)⌋ _),
⇑(λ(h,stk,loc).
(h, stk((length cs',(stkLength P C' M' pc') - 1) :=
Addr (addr_of_sys_xcpt NullPointer)), loc) ),
(_ c',None _))"
(is "valid_edge prog ?e2")
by (auto intro!: JCFG_Invoke_Exc_Update)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
moreover from Cons True Invoke jvm_exec c c' s s' loc' stk' loc'' stk''
prog wt ST ‹h = h'›
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto simp: JVM_CFG_Interpret.kinds_def split_beta)
moreover from True s
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case False
obtain D where D:
"D = fst (method P⇘wf⇙ (cname_of h (the_Addr (stk (length cs, length ST - Suc n')))) M')"
by simp
from c wt s state_correct
have "(P⇘wf⇙),h ⊢ stks (length ST) (λa. stk (length cs, a)) [:≤] ST"
by (clarsimp simp: bv_conform_def correct_state_def)
with False ST wt
have "STs ≠ NT"
apply -
apply (drule_tac p="n'" in list_all2_nthD)
apply simp
apply (auto simp: nth_Cons' split: if_split_asm)
apply hypsubst_thin
by (induct STn, auto simp: nth_Cons' split: if_split_asm)
with applicable ST Invoke sees_M
obtain D' where D': "STs = Class D'"
by (clarsimp simp: nth_append)
from Invoke c s jvm_exec False wt ST D
obtain loc'' where frs': "frs' = ([],loc'',D,M',0)#(snd(snd(state_to_jvm_state P c s)))"
by (auto simp: split_beta if_split_eq1 nth_Cons' ST)
with trg_state_correct
obtain Ts' T' mb' where D_sees_M': "(P⇘wf⇙) ⊢ D sees M':Ts'→T' = mb' in D"
by (auto simp: correct_state_def)
from state_correct c s wt ST D'
have stk_wt: "P⇘wf⇙,h ⊢ stk (length cs, length STn + length STr) #
stks (length STn + length STr) (λa. stk (length cs, a)) [:≤] STn @ Class D' # STr"
by (auto simp: correct_state_def)
have "(stk (length cs, length STn + length STr) #
stks (length STn + length STr) (λa. stk (length cs, a))) ! length STn =
stk (length cs, length STr) "
by (auto simp: nth_Cons' ST)
with stk_wt
have "P⇘wf⇙,h ⊢ stk (length cs, length STr) :≤ Class D'"
by (drule_tac P="conf (P⇘wf⇙) h" and p="length STn" in list_all2_nthD,
auto simp: nth_append)
with False ST wt
have subD': "(P⇘wf⇙) ⊢ (cname_of h (the_Addr (stk (length cs, length ST - Suc n')))) ≼⇧* D'"
by (cases "stk (length cs, length STr)", auto simp: conf_def)
from trg_state_correct frs' D_sees_M' Invoke s c
have "length Ts' = n'"
by (auto dest: sees_method_fun simp: correct_state_def)
with c trg_state_correct wt ST D_sees_M' D P_wf frs' subD' D'
obtain Ts T mxs mxl "is" xt
where stk_sees_M':
"(P⇘wf⇙) ⊢ (cname_of h (the_Addr (stk (length cs, length ST - Suc n'))))
sees M':Ts→T = (mxs,mxl,is,xt) in D"
by (auto dest: sees_method_fun
dest!: sees_method_mono
simp: correct_state_def split_beta nth_append wf_jvm_prog_phi_def
simp del: ST)
with c s False jvm_exec Invoke frs' wt ‹length ST > n'›
have loc'':
"loc'' = stk (length cs, length ST - Suc n') #
rev (take n' (stks (length ST) (λa. stk(length cs, a)))) @
replicate mxl arbitrary"
by (auto simp: split_beta if_split_eq1 simp del: ST)
with trg_state_correct frs' Invoke wt ‹length ST > n'›
have locLength_trg:
"locLength P D M' 0 = n' + Suc mxl"
by (auto dest: list_all2_lengthD simp: correct_state_def)
from stk' frs' c s
have "stk' = stk"
by (auto intro!: ext
simp: nth_stkss nth_Cons' not_less_eq_eq Suc_le_eq
simp del: ST)
from loc' frs' c s loc'' wt ST
have upd_loc': "loc' = (λ(a, b).
if a = Suc (length cs) ⟶ Suc (n' + mxl) ≤ b then loc (a, b)
else if b ≤ n' then stk (length cs, Suc (n' + length STr) - (Suc n' - b))
else arbitrary)"
by (auto intro!: ext
simp: nth_locss nth_Cons' nth_append rev_nth
not_less_eq_eq Suc_le_eq less_Suc_eq add.commute
min.absorb1 min.absorb2 max.absorb1 max.absorb2)
from frs' jvm_exec sem_step prog
have c': "c' = (D,M',0)#c"
by (auto elim!: sem.cases)
from frs'
have "framestack_to_callstack frs' = (D, M', 0) # (C, M, pc) # cs"
by simp
with Invoke c' v_cs v_cs_f2c_frs'
have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk',loc).
stk'(length cs, stkLength P C M pc - Suc n') ≠ Null ∧
fst(method (P⇘wf⇙)
(cname_of h (the_Addr(stk'(length cs, stkLength P C M pc - Suc n')))) M'
) = D
)⇩√,
(_ (C,M,pc)#cs,⌊(c',False)⌋ _))"
(is "valid_edge prog ?e1")
apply auto
apply (fastforce intro: JCFG_Invoke_Normal_Pred)
apply (fastforce intro: JCFG_Invoke_Normal_Pred)
apply (rule exI)
by (fastforce intro: JCFG_Invoke_Normal_Update)
with Invoke v_cs_f2c_frs' c' v_cs
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',False)⌋ _),
⇑(λs.
exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s
(length cs) (stkLength P C M pc) 0 (locLength P D M' 0)
),
(_ (D,M',0)#c,None _))"
(is "valid_edge prog ?e2")
by (fastforce intro!: JCFG_Invoke_Normal_Update
simp del: exec.simps valid_callstack.simps)
with v_pred_edge ‹identifies n c› c c' locLength_trg
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from s s' ‹h = h'› ‹stk' = stk› upd_loc'
locLength_trg stk_sees_M' Invoke c wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (simp add: JVM_CFG_Interpret.kinds_def)
moreover from False s D wt have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case Return
with applicable sees_M
have "length ST > 0"
by clarsimp
then obtain ST1 STr where ST: "ST = ST1#STr" by (cases ST, fastforce+)
show ?thesis
proof (cases cs)
case Nil
with sem_step s s' c prog Return
have c': "c' = [] ∧ C = C0 ∧ M = M0"
by (auto elim!: sem.cases)
with prog sem_step Return Nil c
have v_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
⇑id,
(_Exit_))"
(is "valid_edge prog ?e1")
by (fastforce intro: JCFG_ReturnExit elim: sem.cases)
with ‹identifies n c› c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Return sem_step c c' s s' prog wt Nil ‹length ST > 0›
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto elim!: sem.cases simp: JVM_CFG_Interpret.kinds_def)
moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case (Cons a cs')
with c obtain D M' pc' where c: "c = (C,M,pc)#(D,M',pc')#cs'" by (cases a, fastforce)
with prog sem_step Return
have c': "c' = (D,M',Suc pc')#cs'"
by (auto elim!: sem.cases)
from c s jvm_exec Return
have "h = h'"
by (auto simp: split_beta)
from c s jvm_exec loc' Return
have "loc' = loc"
by (auto intro!: ext
simp: split_beta not_less_eq_eq Suc_le_eq not_less_eq less_Suc_eq_le
nth_locss hd_stks nth_Cons')
from c s jvm_exec stk' Return ST wt trg_state_correct
have stk_upd:
"stk' =
stk((length cs', stkLength P D M' (Suc pc') - 1) :=
stk(Suc (length cs'), length ST - 1))"
by (auto intro!: ext
dest!: list_all2_lengthD
simp: split_beta not_less_eq_eq Suc_le_eq
nth_stkss hd_stks nth_Cons' correct_state_def)
from jvm_exec Return c' c
have "framestack_to_callstack frs' = c'"
by auto
with Return v_cs v_cs_f2c_frs' c' c
have v_edge: "valid_edge prog ((_ (C,M,pc)#(D,M',pc')#cs',None _),
⇑(λs. exec_instr Return P s
(Suc (length cs')) (stkLength P C M pc) (stkLength P D M' (Suc pc')) 0),
(_ (D,M',Suc pc')#cs',None _))"
(is "valid_edge prog ?e1")
by (fastforce intro: JCFG_Return_Update)
with ‹identifies n c› c c'
have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from stk' loc' s s' ‹h = h'› ‹loc' = loc› stk_upd wt
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (simp add: JVM_CFG_Interpret.kinds_def)
moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case Pop
with sem_step s s' c prog
have c': "c' = (C,M,pc+1)#cs"
by (auto elim!: sem.cases)
from Pop sees_M applicable
have "ST ≠ []"
by clarsimp
then obtain ST1 STr where ST: "ST = ST1#STr"
by (cases ST, fastforce+)
with c' jvm_exec Pop
have "framestack_to_callstack frs' = c'"
by auto
with Pop v_cs v_cs_f2c_frs' c'
have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
⇑(λs. exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e1")
by (fastforce intro: JCFG_Straight_NoExc)
with ‹identifies n c› c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Pop jvm_exec s s' stk' loc' c wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto intro!: ext
simp: nth_stkss nth_locss nth_Cons' nth_tl
not_less_eq_eq Suc_le_eq JVM_CFG_Interpret.kinds_def)
moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case IAdd
with sem_step s s' c prog
have c': "c' = (C,M,pc+1)#cs"
by (auto elim!: sem.cases)
from IAdd applicable sees_M
have "length ST > 1"
by clarsimp
then obtain ST1 STr' where "ST = ST1#STr'" by (cases ST, fastforce+)
with ‹length ST > 1› obtain ST2 STr
where ST: "ST = ST1#ST2#STr" by (cases STr', fastforce+)
from c' jvm_exec IAdd
have "framestack_to_callstack frs' = c'"
by auto
with IAdd c' v_cs v_cs_f2c_frs'
have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
⇑(λs. exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e1")
by (fastforce intro: JCFG_Straight_NoExc)
with ‹identifies n c› c c'
have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from IAdd jvm_exec c s s' stk' loc' wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto intro!: ext
simp: nth_stkss nth_locss nth_Cons' nth_tl
hd_stks hd_tl_stks
not_less_eq_eq Suc_le_eq JVM_CFG_Interpret.kinds_def)
moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case (IfFalse b)
with applicable sees_M
have "ST ≠ []"
by clarsimp
then obtain ST1 STr where ST [simp]: "ST = ST1#STr" by (cases ST, fastforce+)
show ?thesis
proof (cases "stk (length cs, stkLength P C M pc - 1) = Bool False ∧ b ≠ 1")
case True
with sem_step s s' c prog IfFalse wt ST
have c': "c' = (C,M,nat (int pc + b))#cs"
by (auto elim!: sem.cases
simp: hd_stks)
with jvm_exec IfFalse True
have "framestack_to_callstack frs' = c'"
by auto
with c' IfFalse True v_cs v_cs_f2c_frs'
have v_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). stk (length cs, stkLength P C M pc - 1) = Bool False)⇩√,
(_ (C,M,nat (int pc + b))#cs,None _))"
(is "valid_edge prog ?e1")
by (fastforce intro: JCFG_IfFalse_False)
with ‹identifies n c› c c' have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from IfFalse True jvm_exec c s s' stk' loc' wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto intro!: ext
simp: hd_stks nth_stkss nth_locss nth_Cons' nth_tl
JVM_CFG_Interpret.kinds_def not_less_eq_eq)
moreover from True s
have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case False
have "nat (int pc + 1) = Suc pc"
by (cases pc, auto)
with False sem_step s s' c prog IfFalse wt ST
have c': "c' = (C,M,Suc pc)#cs"
by (auto elim!: sem.cases simp: hd_stks)
with jvm_exec IfFalse False
have "framestack_to_callstack frs' = c'"
by auto
with c' IfFalse False v_cs v_cs_f2c_frs'
have v_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc). stk (length cs, stkLength P C M pc - 1) ≠ Bool False ∨ b = 1)⇩√,
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e1")
by (fastforce intro: JCFG_IfFalse_Next)
with ‹identifies n c› c c'
have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from IfFalse False jvm_exec c s s' stk' loc' wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto intro!: ext
simp: hd_stks nth_stkss nth_locss nth_Cons' nth_tl
JVM_CFG_Interpret.kinds_def not_less_eq_eq)
moreover from False s
have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case (Goto i)
with sem_step s s' c prog
have c': "c' = (C,M,nat (int pc + i))#cs"
by (auto elim!: sem.cases)
with jvm_exec Goto
have "framestack_to_callstack frs' = c'"
by auto
with c' Goto v_cs v_cs_f2c_frs'
have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
⇑id,
(_ (C,M,nat (int pc + i))#cs,None _))"
(is "valid_edge prog ?e1")
by (fastforce intro: JCFG_Goto_Update)
with ‹identifies n c› c c'
have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Goto jvm_exec c s s' stk' loc'
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto intro!: ext
simp: nth_stkss nth_locss nth_Cons'
JVM_CFG_Interpret.kinds_def not_less_eq_eq)
moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case CmpEq
with sem_step s s' c prog
have c': "c' = (C,M,Suc pc)#cs"
by (auto elim!: sem.cases)
from CmpEq applicable sees_M
have "length ST > 1"
by clarsimp
then obtain ST1 STr' where "ST = ST1#STr'" by (cases ST, fastforce+)
with ‹length ST > 1› obtain ST2 STr
where ST: "ST = ST1#ST2#STr" by (cases STr', fastforce+)
from c' CmpEq jvm_exec
have "framestack_to_callstack frs' = c'"
by auto
with c' CmpEq v_cs v_cs_f2c_frs'
have v_edge:"valid_edge prog ((_ (C,M,pc)#cs,None _),
⇑(λs. exec_instr (instrs_of (P⇘wf⇙) C M ! pc) P s (length cs) (stkLength P C M pc) 0 0),
(_ (C,M,Suc pc)#cs,None _))"
(is "valid_edge prog ?e1")
by (fastforce intro: JCFG_Straight_NoExc)
with ‹identifies n c› c c'
have "JVM_CFG_Interpret.path prog n [?e1] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from CmpEq jvm_exec c s s' stk' loc' wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1]) s = s'"
by (auto intro!: ext
simp: nth_stkss nth_locss nth_Cons' nth_tl
hd_stks hd_tl_stks
not_less_eq_eq JVM_CFG_Interpret.kinds_def)
moreover have "preds (JVM_CFG_Interpret.kinds [?e1]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case Throw
with sees_M applicable
have "ST ≠ []"
by clarsimp
then obtain ST1 STr where ST: "ST = ST1#STr" by (cases ST, fastforce+)
from jvm_exec sem_step
have f2c_frs'_eq_c': "framestack_to_callstack frs' = c'"
by (auto elim: sem.cases)
show ?thesis
proof (cases "stk(length cs, stkLength P C M pc - 1) = Null")
case True
with sem_step Throw s s' c prog wt ST prealloc
have c':"c' = find_handler_for P NullPointer c"
by (fastforce elim!: sem.cases
dest: find_handler_find_handler_forD
simp: hd_stks)
with Throw v_cs v_cs_f2c_frs' f2c_frs'_eq_c' prealloc
have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc).
(stk(length cs, stkLength P C M pc - 1) = Null ∧
find_handler_for P NullPointer ((C,M,pc)#cs) = c') ∨
(stk(length cs, stkLength P C M pc - 1) ≠ Null ∧
find_handler_for P (cname_of h (the_Addr(stk(length cs, stkLength P C M pc - 1))))
((C,M,pc)#cs) = c')
)⇩√,
(_ (C,M,pc)#cs,⌊(c',True)⌋ _))"
(is "valid_edge prog ?e1")
apply (auto simp del: find_handler_for.simps)
apply (fastforce intro: JCFG_Throw_Pred)
apply (fastforce intro: JCFG_Throw_Pred)
apply (cases "find_handler_for P NullPointer ((C, M, pc) # cs)")
apply (fastforce intro: JCFG_Throw_Exit)
by (fastforce intro: JCFG_Throw_Update)
show ?thesis
proof (cases c')
case Nil
with prog Throw c c' sem_step v_pred_edge
have v_exec_edge: "valid_edge prog ((_ (C,M,pc)#cs,⌊([],True)⌋ _),
⇑id,
(_Exit_))"
(is "valid_edge prog ?e2")
by (auto intro: JCFG_Throw_Exit)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(simp,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce)
moreover from Throw jvm_exec c c' s s' stk' loc'
True Nil wt ST trg_state_correct prealloc
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (cases frs',
auto dest: find_handler_find_handler_forD
simp: JVM_CFG_Interpret.kinds_def split_beta correct_state_def)
moreover from True s wt c' c have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case (Cons a cs')
then obtain C' M' pc'
where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
with jvm_exec s loc' c True Throw wt ST
have "loc' = loc"
by (auto intro!: ext
simp: find_handler_loc_fun_eq'
not_less_eq_eq nth_Cons' nth_locss)
from c Cons s s' sem_step jvm_exec prog
have "stk' = update_stk stk frs'"
and "(C',M',pc')#cs' = framestack_to_callstack frs'"
by (auto elim!: sem.cases)
moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
and "cs' = framestack_to_callstack frs''" using calculation
by (cases frs', fastforce+)
ultimately
have stk'':
"update_stk stk frs' =
stk((length cs',stkLength P C' M' pc' - Suc 0) := Addr (addr_of_sys_xcpt NullPointer))"
using c s Cons True prog Throw ST wt trg_state_correct jvm_exec
by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
auto dest!: list_all2_lengthD
simp: nth_Cons' split_beta correct_state_def if_split_eq1)
from ‹(C',M',pc')#cs' = framestack_to_callstack frs'› Cons
have "framestack_to_callstack frs' = c'"
by simp
with Cons Throw v_cs v_cs_f2c_frs' v_pred_edge
have v_exec_edge:
"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',True)⌋ _),
⇑(λ(h,stk,loc).
(h,
stk((length cs',stkLength P C' M' pc' - 1) :=
if (stk(length cs, stkLength P C M pc - 1) = Null)
then Addr (addr_of_sys_xcpt NullPointer)
else (stk(length cs, stkLength P C M pc - 1))),
loc)
),
(_ c',None _))"
(is "valid_edge prog ?e2")
by (auto intro!: JCFG_Throw_Update)
with v_pred_edge ‹identifies n c› c c' True prog
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
moreover from Cons True Throw jvm_exec c c' s s' ‹loc' = loc› stk' stk'' wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto dest: find_handler_heap_eqD simp: JVM_CFG_Interpret.kinds_def)
moreover from True s wt c c'
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
next
case False
with sem_step Throw s s' c prog wt ST prealloc
have c':
"c' = find_handler_for P
(cname_of h (the_Addr(stk(length cs, stkLength P C M pc - 1)))) c"
by (fastforce elim!: sem.cases
dest: find_handler_find_handler_forD
simp: hd_stks)
with Throw v_cs v_cs_f2c_frs' f2c_frs'_eq_c'
have v_pred_edge: "valid_edge prog ((_ (C,M,pc)#cs,None _),
(λ(h,stk,loc).
(stk(length cs, stkLength P C M pc - 1) = Null ∧
find_handler_for P NullPointer ((C,M,pc)#cs) = c') ∨
(stk(length cs, stkLength P C M pc - 1) ≠ Null ∧
find_handler_for P (cname_of h (the_Addr(stk(length cs, stkLength P C M pc - 1))))
((C,M,pc)#cs) = c')
)⇩√,
(_ (C,M,pc)#cs,⌊(c',True)⌋ _))"
(is "valid_edge prog ?e1")
apply (auto simp del: find_handler_for.simps)
apply (fastforce intro: JCFG_Throw_Pred)
apply (fastforce intro: JCFG_Throw_Pred)
apply (cases "find_handler_for P
(cname_of h (the_Addr(stk(length cs, stkLength P C M pc - 1)))) ((C,M,pc)#cs)")
apply (fastforce intro: JCFG_Throw_Exit)
by (fastforce intro: JCFG_Throw_Update)
show ?thesis
proof (cases c')
case Nil
with prog Throw c c' v_pred_edge
have v_exec_edge: "valid_edge prog ((_ (C,M,pc)#cs,⌊([],True)⌋ _),
⇑id,
(_Exit_))"
(is "valid_edge prog ?e2")
by (auto intro!: JCFG_Throw_Exit)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
moreover from Throw jvm_exec c c' s s' False Nil trg_state_correct wt ST
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (cases frs',
auto dest: find_handler_find_handler_forD
simp: JVM_CFG_Interpret.kinds_def correct_state_def)
moreover from False s wt c' c
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
next
case (Cons a cs')
then obtain C' M' pc'
where Cons: "c' = (C',M',pc')#cs'" by (cases a, fastforce)
with jvm_exec s loc' c Throw wt ST
have "loc' = loc"
by (auto intro!: ext
simp: find_handler_loc_fun_eq'
not_less_eq_eq nth_Cons' nth_locss)
from c Cons s s' sem_step jvm_exec prog
have "stk' = update_stk stk frs'"
and "(C',M',pc')#cs' = framestack_to_callstack frs'"
by (auto elim!: sem.cases)
moreover obtain stk'' loc'' frs'' where "frs' = (stk'',loc'',C',M',pc')#frs''"
and "cs' = framestack_to_callstack frs''" using calculation
by (cases frs', fastforce+)
ultimately
have stk'':
"update_stk stk frs' =
stk((length cs',stkLength P C' M' pc' - Suc 0) :=
Addr (the_Addr (stk((length cs, stkLength P C M pc - Suc 0)))))"
using c s Cons False prog Throw ST wt trg_state_correct jvm_exec
by -(rule find_handler_stk_fun_eq' [of P _ h "(C,M,pc)#cs" _ loc h'],
auto dest!: list_all2_lengthD
simp: nth_Cons' split_beta correct_state_def if_split_eq1)
from applicable False Throw ST sees_M
have "is_refT ST1"
by clarsimp
with state_correct wt ST c False
have addr_the_addr_stk_eq:
"Addr(the_Addr(stk(length cs, length STr))) = stk(length cs, length STr)"
by (cases "stk (length cs, length STr)",
auto simp: correct_state_def is_refT_def conf_def)
from ‹(C',M',pc')#cs' = framestack_to_callstack frs'› Cons
have "framestack_to_callstack frs' = c'"
by simp
with Cons Throw v_cs v_cs_f2c_frs' v_pred_edge
have v_exec_edge:"valid_edge prog ((_ (C,M,pc)#cs,⌊(c',True)⌋ _),
⇑(λ(h,stk,loc).
(h,
stk((length cs',stkLength P C' M' pc' - 1) :=
if (stk(length cs, stkLength P C M pc - 1) = Null)
then Addr (addr_of_sys_xcpt NullPointer)
else (stk(length cs, stkLength P C M pc - 1))),
loc)),
(_ c',None _))"
(is "valid_edge prog ?e2")
by (auto intro!: JCFG_Throw_Update)
with v_pred_edge ‹identifies n c› c c' Nil
have "JVM_CFG_Interpret.path prog n [?e1,?e2] (_ c',None _)"
by -(rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.Cons_path,
rule JVM_CFG_Interpret.path.empty_path,
auto simp: JVM_CFG_Interpret.valid_node_def, fastforce+)
moreover from Cons False Throw jvm_exec c c' s s' loc' stk'
addr_the_addr_stk_eq prog wt ST ‹loc' = loc› stk''
have "transfers (JVM_CFG_Interpret.kinds [?e1,?e2]) s = s'"
by (auto dest: find_handler_heap_eqD
simp: JVM_CFG_Interpret.kinds_def)
moreover from False s wt c c'
have "preds (JVM_CFG_Interpret.kinds [?e1,?e2]) s"
by (simp add: JVM_CFG_Interpret.kinds_def)
ultimately show ?thesis by fastforce
qed
qed
qed
qed
qed
end